home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / C / LIB / PARI / PARI2 / pari / other / mp_ami < prev    next >
Text File  |  1991-08-07  |  168KB  |  6,761 lines
  1. *********************************************************************
  2. *===================================================================*
  3. **                                   **
  4. *=                                   =*
  5. **                                   **
  6. *=     oooooooooo       ooooo       oooooooooo      ooooo       =*
  7. **    ooooooooooo      ooooooooo    ooooooooooo     ooo        **
  8. **    ooo     ooo     ooo     ooo     ooo     ooo     ooo        **
  9. *=    ooo     ooo     ooo     ooo     ooo     ooo     ooo        =*
  10. **    ooooooooooo     ooooooooooo     oooooooooo    ooo        **
  11. *=    oooooooooo    ooooooooooo     ooooooooooo     ooo        =*
  12. **    ooo         ooo     ooo     ooo     ooo     ooo        **
  13. *=    ooo         ooo     ooo     ooo     ooo     ooo        =*
  14. **     ooooo           ooooo   ooooo   ooooo   ooooo   ooooo       **
  15. **                                   **
  16. *=                                   =*
  17. **            version numero 2               **
  18. **                                   **
  19. *=               commentee                   =*
  20. **                                   **
  21. *=           fichier cree le 22 sept. 1987           =*
  22. **                                   **
  23. *=                par                    =*
  24. **                                   **
  25. *=      christian batut , henri cohen , michel olivier       =*
  26. **                                   **
  27. *=      """"""""""""""""""""""""""""""""""""""""""""""       =*
  28. **                                   **
  29. **                                   **
  30. *===================================================================*
  31. *********************************************************************
  32.  
  33.  
  34. *-------------------------------------------------------------------*
  35. *                                    *
  36. *  Notations :                            *
  37. *        T = type ( S , I , ou R ).                *
  38. *        R = type reel.                    *
  39. *        S = type entier court ( long du C).         *
  40. *        P = p-adique.                    *
  41. *                                    *
  42. *        L = longueur de la mantisse pour un reel ;        *
  43. *            longueur de la mantisse effective pour un entier*
  44. *        l = longueur totale du nombre avec codage.        *
  45. *        le= longueur effective totale de l'entier avec code *
  46. *            on doit avoir : l <= 2^15-1.            *
  47. *                                    *
  48. *        exp = exposant non biaise d'un reel.                *
  49. *        fexp= exposant biaise ( fexp = exp + 2^23 ).    *
  50. *              on doit avoir : -2^23 <= exp < 2^23        *
  51. *        fvalp=valuation p-adique biaisee d'un p-adique.     *
  52. *              ( fvalp = valuation + 2^15 )            *
  53. *                                    *
  54. *-------------------------------------------------------------------*
  55.  
  56.  
  57.  
  58.  
  59. *-------------------------------------------------------------------*
  60. *                                    *
  61. *    Conventions :                            *
  62. *        Tous les sous programmes creent la place necessaire *
  63. *        pour stocker le resultat , a l'exception des        *
  64. *        programmes d'affectation et d'echange , ainsi que    *
  65. *        des programmes dont le nom se termine par la lettre *
  66. *        "z" . On entre dans ces derniers avec une zone creee*
  67. *        dans la pile PARI ou le resultat est range.     *
  68. *                                    *
  69. *        Le nombre reel 0 s'ecrit avec mantisse non          *
  70. *        significative;le deuxieme lgmot code contient    *
  71. *        -32*L + (2^23) ou L est la longueur de la mantisse    *
  72. *                                    *
  73. *        Les registres a0,a1,d0,d1 sont en general utilises    *
  74. *        par les programmes et ne sont pas restaures a leurs *
  75. *        valeurs d'entree.Tous les autres sont sauvegardes.  *
  76. *                                    *
  77. *        Les objets utilises par PARI sont crees dans une    *
  78. *        pile dite dans la suite "pile PARI",pointee par     *
  79. *        _avma.                        *
  80. *                                    *
  81. *-------------------------------------------------------------------*
  82.  
  83.  
  84.  
  85.  
  86.  
  87. affer1     EQU    1
  88. affer2     EQU    2
  89. affer3     EQU    3
  90. affer4     EQU    4
  91. affer5     EQU    5
  92. exger1     EQU    6
  93. exger2     EQU    7
  94. shier1     EQU    8
  95. shier2     EQU    9
  96. truer1     EQU    10
  97. truer2     EQU    11
  98. adder1     EQU    12
  99. adder2     EQU    13
  100. adder3     EQU    14
  101. adder4     EQU    15
  102. adder5     EQU    16
  103. muler1     EQU    17
  104. muler2     EQU    18
  105. muler3     EQU    19
  106. muler4     EQU    20
  107. muler5     EQU    21
  108. muler6     EQU    22
  109. diver1     EQU    23
  110. diver2     EQU    24
  111. diver3     EQU    25
  112. diver4     EQU    26
  113. diver5     EQU    27
  114. diver6     EQU    28
  115. diver7     EQU    29
  116. diver8     EQU    30
  117. diver9     EQU    31
  118. diver10  EQU    32
  119. diver11  EQU    33
  120. diver12  EQU    34
  121. divzer1  EQU    35
  122. dvmer1     EQU    36
  123. dvmzer1  EQU    37
  124. moder1     EQU    38
  125. modzer1  EQU    39
  126. reser1     EQU    40
  127. reszer1  EQU    41
  128. arier1     EQU    42
  129. arier2     EQU    43
  130. errpile  EQU    44
  131. rtodber  EQU    45
  132. gerper     EQU    46
  133.  
  134.     MACHINE MC68020
  135.  
  136.     cseg
  137.  
  138.     PUBLIC    _avma,_top,_bot,_lontyp,_err
  139.     XDEF    _typ,_lg,_lgef,_mant,_signe,_expo,_pere,_valp,_precp,_varn
  140.     XDEF    _settyp,_setlg,_setlgef,_setmant,_setsigne,_setexpo,_expi
  141.     XDEF    _setpere,_incpere,_setvalp,_setprecp,_setvarn
  142.     XDEF    _cget,_cgetg,_cgeti,_cgetr,_cgiv,_gerepile
  143.     XDEF    _mpaff,_affsz,_affsi,_affsr,_affii,_affir
  144.     XDEF    _affrs,_affri,_affrr
  145.     XDEF    _stoi,_itos
  146.     XDEF    _mpneg,_mpnegz,_negs,_negi,_negr
  147.     XDEF    _mpabs,_mpabsz,_abss,_absi,_absr
  148.     XDEF    _mptrunc,_mptruncz,_mpent,_mpentz
  149.     XDEF    _mpexg,_vals,_vali
  150.     XDEF    _mpshift,_mpshiftz,_shifts,_shifti,_shiftr
  151.     XDEF    _mpcmp,_cmpss,_cmpsi,_cmpsr,_cmpis,_cmpii,_cmpir
  152.     XDEF    _cmprs,_cmpri,_cmprr
  153.     XDEF    _mpadd,_addss,_addsi,_addsr,_addii,_addir,_addrr
  154.     XDEF    _mpaddz,_addssz,_addsiz,_addsrz,_addiiz,_addirz,_addrrz
  155.     XDEF    _mpsub,_subss,_subsi,_subsr,_subis,_subii,_subir
  156.     XDEF    _subrs,_subri,_subrr
  157.     XDEF    _mpsubz,_subssz,_subsiz,_subsrz,_subisz,_subiiz,_subirz
  158.     XDEF    _subrsz,_subriz,_subrrz
  159.     XDEF    _mpmul,_mulss,_mulmodll,_mulsi,_mulsr,_mulii,_mulir,_mulrr
  160.     XDEF    _mpmulz,_mulssz,_mulsiz,_mulsrz,_muliiz,_mulirz,_mulrrz
  161.     XDEF    _dvmdss,_dvmdsi,_dvmdis,_dvmdii
  162.     XDEF    _mpdvmdz,_dvmdssz,_dvmdsiz,_dvmdisz,_dvmdiiz
  163.     XDEF    _mpdiv,_divss,_divsi,_divsr,_divis,_divii,_divir
  164.     XDEF    _divrs,_divri,_divrr
  165.     XDEF    _mpdivis,_divise
  166.     XDEF    _mpdivz,_divssz,_divsiz,_divsrz,_divisz,_diviiz,_divirz
  167.     XDEF    _divrsz,_divriz,_divrrz
  168.     XDEF    _mpinvz,_mpinvsr,_mpinvir,_mpinvrr
  169.     XDEF    _modss,_modsi,_modis,_modii
  170.     XDEF    _mpmodz,_modssz,_modsiz,_modisz,_modiiz
  171.     XDEF    _resss,_ressi,_resis,_resii
  172.     XDEF    _mpresz,_resssz,_ressiz,_resisz,_resiiz
  173.     XDEF    _convi,_confrac
  174.     XDEF    _addsii,_mulsii,_divisii
  175.  
  176.  
  177. *********************************************************************
  178. *********************************************************************
  179. ***                                   ***
  180. ***         PROGRAMMES DE GESTION DE LA MEMOIRE PARI      ***
  181. ***                                   ***
  182. *********************************************************************
  183. *********************************************************************
  184.  
  185.  
  186.  
  187. *===================================================================*
  188. *                                    *
  189. *        Allocation memoire dans pile PARI en C            *
  190. *                                    *
  191. *    entree : a7@(4) contient la longueur totale a attribuer     *
  192. *    sortie : d0 pointe sur un type I ou R            *
  193. *         d1 et a1 sont inutilises                *
  194. *                                    *
  195. *===================================================================*
  196.  
  197. _cget     move.l    4(sp),d0
  198.     bsr.s     _get
  199.     move.l    a0,d0
  200.     rts
  201.  
  202. _cgetg  move.l    8(sp),d0    ; a7@(8) contient le type
  203.     ror.l    #8,d0
  204.     move.w    6(sp),d0
  205.     bsr.s     _get
  206.     move.l    a0,d0
  207.     rts
  208.     
  209. _cgeti  move.l    4(sp),d0
  210.     bsr.s     _geti
  211.     move.l    a0,d0
  212.     rts
  213.  
  214. _cgetr  move.l    4(sp),d0
  215.     bsr.s     _getr
  216.     move.l    a0,d0
  217.     rts
  218.  
  219. *===================================================================*
  220. *                                    *
  221. *        Allocation memoire dans pile PARI            *
  222. *                                    *
  223. *    entree : d0.w contient le nombre total de longs mots    *
  224. *         demandes si type I ou R                *
  225. *    sortie : a0 pointe sur la zone allouee ; _avma est mis    *
  226. *         a jour ; message d'erreur si memoire insuffisante ;*
  227. *         d0 est inchange;d1 et a1 sont sauvegardes.     *
  228. *    remarque : il est interdit de creer des type S dans la pile *
  229. *                                    *
  230. *===================================================================*
  231.  
  232.                 ; allocation memoire type qcque
  233.  
  234. _get     move.l    d1,-(sp)     ; d0.l contient code et longueur
  235.     moveq    #0,d1
  236.     move.w    d0,d1
  237.     lsl.l    #2,d1
  238.     move.l    _avma,a0
  239.     sub.l    d1,a0
  240.     cmp.l    _bot,a0
  241.     bmi.s     mnet
  242.     move.l    a0,_avma
  243.     swap    d0
  244.     move.b    #1,d0
  245.     swap    d0
  246.     move.l    d0,(a0)
  247.     move.l    (sp)+,d1
  248.     rts
  249.  
  250.                 ; allocation memoire de type I
  251.  
  252. _geti     move.l    d1,-(sp)
  253.     moveq    #0,d1
  254.     move.w    d0,d1
  255.     lsl.l    #2,d1
  256.     move.l    _avma,a0
  257.     sub.l    d1,a0
  258.     cmp.l    _bot,a0
  259.     bmi.s     mnet
  260.     move.l    a0,_avma
  261.     move.w    #$101,(a0)
  262.     move.w    d0,2(a0)
  263.     move.l    (sp)+,d1
  264.     rts
  265.  
  266.                 ; allocation memoire type R
  267.  
  268. _getr     move.l    d1,-(sp)
  269.     moveq    #0,d1
  270.     move.w    d0,d1
  271.     lsl.l    #2,d1
  272.     move.l    _avma,a0
  273.     sub.l    d1,a0
  274.     cmp.l    _bot,a0
  275.     bmi.s     mnet
  276.     move.l    a0,_avma
  277.     move.w    #$201,(a0)
  278.     move.w    d0,2(a0)
  279.     move.l    (sp)+,d1
  280.     rts
  281.  
  282.                 ; nettoyage pile PARI
  283.                 ; a ecrire .....!!!!!!!!!
  284. mnet     move.l    #errpile,-(sp)
  285.     jsr     _err
  286.  
  287. *===================================================================*
  288. *                                    *
  289. *        Desallocation memoire PARI en C             *
  290. *                                    *
  291. *    entree : a7@(4) pointe sur un type I ou R            *
  292. *    sortie : la zone occupee est desallouee             *
  293. *                                    *
  294. *===================================================================*
  295.  
  296.  
  297. _cgiv     move.l    4(sp),a0    ; est suivi par giv
  298.                 
  299.  
  300. *===================================================================*
  301. *                                    *
  302. *        Desallocation memoire PARI                *
  303. *                                    *
  304. *    entree : a0@ contient le premier long mot code d'une        *
  305. *         zone memoire a desallouer : uniquement de type     *
  306. *         I ou R                         *
  307. *    sortie : __avma est mis a jour si necessaire ; ou bien le    *
  308. *         nombre de peres de la zone est decremente.     *
  309. *         a0 pointe sur _avma a jour                *
  310. *         tous les autres registres sont inchanges        *
  311. *                                    *
  312. *===================================================================*
  313.  
  314. _giv     move.l    d0,-(sp)
  315.     cmp.b    #$ff,1(a0)    ; comparaison nb peres avec 255
  316.     beq.s     givf
  317.                 ; ici le nb de peres est non sature
  318.     cmp.l    _avma,a0
  319.     beq.s     giv1
  320.                 ; ici diminuer le nb de peres de 1
  321.     sub.b    #1,1(a0)
  322. givf     move.l    (sp)+,d0
  323.     rts
  324.                 ; ici la zone est en tete de pile
  325. giv1     sub.b    #1,1(a0)
  326.     bne.s     givf
  327.                 ; ici on desalloue la zone
  328. 1$      move.w    2(a0),d0
  329.     lea     0(a0,d0.w*4),a0; a0 pointe sur zone suivante
  330.     move.l    a0,_avma
  331.     tst.b    1(a0)
  332.     beq.s     1$        ; aller desallouer zone suivante
  333.     bra.s     givf        ; si zone suivante a un seul pere
  334.                 ; ou si a0 = top memoire ( cf init)
  335.  
  336. *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
  337. *                                  *
  338. *            GESTION DE PILE               *
  339. *                                  *
  340. *    Entree : sp($4) et sp($8) contiennent 2 adresses l > p      *
  341. *         sp($12) contient 0 ou une adresse q ;          *
  342. *                                  *
  343. *    Sortie : la zone entre p et l est ecrasee ;           *
  344. *    -     la zone entre _avma et p est decalee d'autant ;   *
  345. *    -     tous les pointeurs situes dans cette derniere      *
  346. *         zone et qui pointent avant p sont mis a jour      *
  347. *         et q est augmente du decalage .          *
  348. *         ( d0 contient celui ci ou le decalage en octets )*
  349. *    -     de plus si q est non nul la racine pointee par l *
  350. *         est mise a jour si il y a lieu .          *
  351. *    -     _avma est mis a jour ( augmente du decalage )      *
  352. *                                  *
  353. *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
  354.  
  355. _gerepile  movem.l d2-d6/a2-a3,-(sp)
  356.         move.l    _avma,d5
  357.         move.l    32(sp),d2        ; l adresse fin de la zone a detruire
  358.         move.l    d2,a0
  359.         move.l    d2,d4
  360.         move.l    36(sp),d1        ; p adresse deb de la zone a detruire
  361.         move.l    d1,a1
  362.         move.l    d1,d0
  363.         sub.l    d0,d2             ; decalage ( en octets ) = l - p
  364.         bhi.s     10$               ; si l <= p rien a faire
  365.         move.l    40(sp),d0
  366.         bra.s     9$
  367. 10$     sub.l    d5,d1
  368.         lsr.l    #2,d1             ; nb de lg mots a decaler
  369.         bra.s     2$
  370. 1$      move.l    -(a1),-(a0)
  371. 2$      dbra    d1,1$             ; boucle de decalage
  372.         sub.l    #$10000,d1
  373.         bge.s     1$
  374.         move.l    a0,_avma          ; nouvel _avma et debut zone recopiee
  375.         clr.l    d3
  376.         lea     _lontyp,a3        ; tableau des types
  377. *---------------------------------| mise a jour de la zone recopiee :
  378.                                   ; d4 pointe debut zone recopiee
  379.                                   ; a0 pointe apres fin zone recopiee
  380. 3$      move.b    (a0),d3         ; type de la zone examinee
  381.         move.l    0(a3,d3.w*4),d1 ; d1 recoit _lontyp[typ(l1)]
  382.         lea     0(a0,d1.l*4),a1   ; a1 pointe sur le dernier mot code
  383.         move.w    2(a0),d1        ; longueur de la zone examinee
  384.     move.l     a0,a2
  385.         lea     0(a0,d1.w*4),a0   ; a0 pointe apres fin de cette zone
  386.     cmp.b    #10,d3              ; type polynome ?
  387.     bne    13$
  388.     move.w    6(a2),d6     ; oui, longueur effective > vraie longueur
  389.     cmp.w    d1,d6
  390.     bhi    6$     ; si oui la zone est finie.
  391.     lea    0(a2,d6.w*4),a2
  392.     bra.s    4$
  393. 13$    move.l    a0,a2
  394.     subq.l    #4,a1
  395. 8$      addq.l   #4,a1             ; passer au lgmot suivant de la zone examinee
  396. 4$      cmp.l    a2,a1             ; a t'on fini pour cette zone
  397.         bcc.s     6$                ; si oui zone suivante
  398.         cmp.l    (a1),d0            ; sinon le lgmot examine pointe t'il avant p ?
  399.         bls.s     5$                ; sinon ne rien faire
  400.         cmp.l    (a1),d5            ; si oui, verifier que le long mot examine
  401.         bhi.s     8$                ; pointe apres _avma
  402.         add.l    d2,(a1)+           ; si oui ajouter decalage
  403.         bra.s     4$
  404. 5$      cmp.l    (a1)+,d4           ; le longmot pointe t'il apres l ?
  405.         bls.s     4$                ; si oui ok
  406.         cmp.l    d4,a0
  407.         bhi.s     4$
  408.         move.l    #gerper,-(sp)      ; sinon erreur
  409.         jsr     _err
  410. 6$      cmp.l    d4,a0             ; a t'on fini ?
  411.         bcs.s     3$                ; si a0 < d4 non : traiter zone suivante
  412.         bne.s     7$                ; si a0 > d4 oui
  413.         tst.l    40(sp)           ; si a0 = d4 et q = 0 oui
  414.         bne.s     3$                ; sinon traiter zone suivante :
  415.  
  416. 7$      move.l    d0,d1
  417.     move.l    40(sp),d0
  418.         beq.s     11$
  419.         cmp.l    d0,d1             ; si q pointe apres p retourner q
  420.         bls.s     9$                ; sinon
  421.         cmp.l    d0,d5
  422.         bhi.s     9$
  423. 11$     add.l    d2,d0             ; retourner q + decalage ( ou decalage )
  424. 9$      movem.l  (sp)+,d2-d6/a2-a3
  425.     rts
  426.  
  427.  
  428. *********************************************************************
  429. *********************************************************************
  430. ***                                   ***
  431. ***     TYPE , MANTISSE , LONGUEUR , EXPOSANT , SIGNE .       ***
  432. ***                                   ***
  433. ***     VALUATION , PRECISION DES P-ADIQUES , VARIABLES.      ***
  434. ***                                   ***
  435. *********************************************************************
  436. *********************************************************************
  437.  
  438.  
  439.                 ; entree:a7($4) pointe sur n type IouR
  440.                 ; sortie:d0.l recoit le type de n
  441.  
  442. _typ     moveq    #0,d0    
  443.     move.b    ([4,sp]),d0
  444.     rts
  445.  
  446.                 ; entree:a7($4) pointe sur n typeIouR
  447.                 ; a7($8) contient le long t
  448.                 ; sortie:le type de la zone pointee
  449.                 ; par a7($4) est force a t        
  450.  
  451. _settyp move.b    11(sp),([4,sp])
  452.     rts
  453.  
  454.                 ; entree:a7($4) pointe sur P type pol ou ser
  455.                 ; sortie:d0.l recoit la variable de P
  456.  
  457. _varn     moveq    #0,d0
  458.     move.b    ([4,sp],5),d0
  459.     rts
  460.  
  461.                 ; entree:a7($4) pointe sur P type pol ou ser
  462.                 ; a7($8) contient le long t <= 255
  463.                 ; sortie:la variable de P est mise a t.
  464.  
  465. _setvarn  move.b    11(sp),([4,sp],5)
  466.     rts
  467.  
  468.                                 ; entree:a7($4) pointe sur un type IouR
  469.                                 ; a7($8) contient un long i
  470.                                 ; sortie:d0.l contient le ieme longmot
  471.                                 ; de la mantisse de n
  472.  
  473. _mant   move.l    4(sp),a0
  474.         tst.b    4(a0)
  475.         bne.s     1$
  476.         moveq   #0,d0
  477.         rts
  478. 1$      move.w    10(sp),d0      ; indice en mantisse
  479.         move.l    4(a0,d0.w*4),d0
  480.         rts
  481.  
  482.                 ; entree:a7($4) pointe sur n type IouR
  483.                 ; a7($8) contient un long i
  484.                 ; a7($12) contient un long m
  485.                 ; sortie:le i-eme long mot de mantisse
  486.                 ; de n est force a m
  487.  
  488.  
  489. _setmant move.l    4(sp),a0    ; adresse du nombre
  490.     move.w    10(sp),d0    ; indice en mantisse
  491.     lea     4(a0,d0.w*4),a0
  492.     move.l    12(sp),(a0)     ; met nouveau lgmot de mantisse
  493.     rts
  494.  
  495.                 ; entree:a7($4) pointe sur n type IouR
  496.                 ; sortie:d0.l contient longueur totale n
  497.  
  498. _lg     moveq    #0,d0
  499.     move.w    ([4,sp],2),d0
  500.     rts
  501.  
  502.                 ; entree:a7($4) pointe sur n type IouR
  503.                 ; a7($8) contient un long l
  504.                 ; sortie:la longueur totale de n est
  505.                 ; forcee a l
  506.  
  507. _setlg  move.w    10(sp),([4,sp],2)
  508.     rts
  509.  
  510.                 ; entree:a7($4) pointe sur n de type I
  511.                 ; sortie:d0.l contient long.effect.de n
  512.  
  513. _lgef     moveq    #0,d0
  514.     move.w    ([4,sp],6),d0
  515.     rts
  516.  
  517.                 ; entree:a7($4) pointe sur n de type I
  518.                 ; a7($8) contient un long l
  519.                 ; sortie:la longueur effective de n est
  520.                 ; forcee a l
  521.  
  522. _setlgef move.w    10(sp),([4,sp],6)
  523.     rts
  524.  
  525.                 ; entree:a7($4) pointe sur n type IouR
  526.                 ; sortie:d0.l contient le signe de n
  527.  
  528. _signe  move.b    ([4,sp],4),d0    ; octet numero 5 du gen
  529.     move.b    ([4,sp]),d1    ; type du gen
  530.     cmp.b    #3,d1
  531.     bcs.s     1$
  532.     cmp.b    #4,d1
  533.     beq.s     2$
  534.     cmp.b    #5,d1
  535.     bne.s     1$
  536. 2$      move.l    ([4,sp],4),a0    ; ici fraction
  537.     move.b    4(a0),d0    ; on renvoie le sgn du num !
  538. 1$      extb.l    d0
  539.     rts
  540.  
  541.                 ; entree:a7($4) pointe sur n tyxYhr+R
  542.                 ; a7($8) contient un long s
  543.                 ; sortie:le signe de n est force a s
  544.  
  545. _setsigne move.b    11(sp),([4,sp],4)
  546.     rts
  547.  
  548.                 ; entree:a7($4) pointe sur n type IouP
  549.                 ; sortie:d0.l contient nomb. peres de n
  550.  
  551. _pere     moveq    #0,d0
  552.     move.b    ([4,sp],1),d0
  553.     rts
  554.  
  555.                 ; entree:a7($4) pointe sur n type IouR
  556.                 ; a7($8) contient un long s
  557.                 ; sortie:le nomb. peres de n est s
  558.  
  559. _setpere move.b    11(sp),([4,sp],1)
  560.     rts
  561.  
  562.                 ; augmente de 1 le nombre de peres du
  563.                 ; IouR pointe par a7($4)
  564.  
  565. _incpere addq.b    #1,([4,sp],1)
  566.     bne.s     1$
  567.     move.b    #255,([4,sp],1)
  568. 1$      rts
  569.  
  570.                 ; entree:a7($4) pointe sur n de type R
  571.                 ; sortie:d0.l contient le vrai exposant de n
  572.  
  573. _expo     move.l    ([4,sp],4),d0
  574.     and.l    #$ffffff,d0
  575.     sub.l    #$800000,d0
  576.     rts
  577.                 ; entree:a7($4) pointe sur n de type I non nul
  578.                 ; sortie:d0.l contient l'exposant de n
  579.  
  580. _expi     move.l    4(sp),a0
  581.     moveq    #0,d0
  582.     move.w    6(a0),d0
  583.     subq.l    #2,d0
  584.     lsl.l    #5,d0
  585.     move.l    8(a0),d1
  586.     bfffo    d1{0:32},d1
  587.     addql    #1,d1
  588.     sub.l    d1,d0
  589.     rts
  590.                 ; entree:a7($4) pointe sur n de type R
  591.                 ; a7($8) contient le long ex
  592.                 ; sortie:l'exposant de n est force a ex
  593.                 ; ou ex est le vrai exposant(non biaise)
  594.  
  595. _setexpo move.l    8(sp),d0
  596.     add.l    #$800000,d0
  597.     move.l    4(sp),a0
  598.     move.b    4(a0),d1
  599.     move.l    d0,4(a0)
  600.     move.b    d1,4(a0)
  601.     rts
  602.  
  603.                 ; entree:a7($4) pointe sur n de type p-adique
  604.                 ; ou serie.
  605.                 ; sortie:d0.l contient la valuation non biaisee
  606.  
  607. _valp     moveq    #0,d0
  608.     move.w    ([4,sp],6),d0
  609.     sub.l    #$8000,d0
  610.     rts
  611.  
  612.                 ; entree:a7($4) pointe sur n de type p-adique
  613.                 ; ou serie. a7($8) contient le long valp
  614.                 ; sortie:la valuation de n est
  615.                 ; forcee a valp.
  616.  
  617. _setvalp  move.l    8(sp),d0
  618.     add.l    #$8000,d0
  619.     move.w    d0,([4,sp],6)
  620.     rts
  621.  
  622.                 ; entree:a7($4) pointe sur n de type P
  623.                 ; sortie:d0.l contient la precision de n
  624.  
  625. _precp  moveq    #0,d0
  626.     move.w    ([4,sp],4),d0
  627.     rts
  628.  
  629.                 ; entree:a7($4) pointe sur n de type P
  630.                 ; a7($8) contient le long precp
  631.                 ; sortie:la precision de n est forcee
  632.                 ; a precp
  633.  
  634. _setprecp move.l    8(sp),d0
  635.     move.l    4(sp),a0
  636.     move.w    d0,4(a0)
  637.     rts
  638.  
  639.  
  640.  
  641.  
  642.  
  643. *********************************************************************
  644. *********************************************************************
  645. ***                                   ***
  646. ***         PROGRAMMES D'AFFECTATION OU D'ECHANGE          ***
  647. ***                                   ***
  648. *********************************************************************
  649. *********************************************************************
  650.  
  651.  
  652.  
  653.  
  654.  
  655. *===================================================================*
  656. *                                    *
  657. *    Affectation generale    n2 --> n1                *
  658. *                                    *
  659. *    entree : a7($4) pointe sur n2 de type I ou R        *
  660. *         a7($8) pointe sur n1 de type I ou R        *
  661. *    sortie : la zone pointee par a7($8) contient n2         *
  662. *    interdit : n2 ou n1 de type S                *
  663. *    remarques: erreur dans le cas R --> I            *
  664. *           d0,d1,a0,a1 sont inchanges            *
  665. *                                    *
  666. *===================================================================*
  667.  
  668. _mpaff  cmp.b    #1,([8,sp])
  669.     bne.s     1$
  670.                 ; ici T1 = I
  671.     cmp.b    #1,([4,sp])
  672.     beq.s     _affii        ; ici T1 = T2 = I
  673.     bra     _affri        ; ici T1 = I et T2 = R
  674.                 ; ici T1 = R
  675. 1$      cmp.b    #1,([4,sp])
  676.     beq     _affir        ; ici T1 = R et T2 = I
  677.     bra     _affrr        ; ici T1 = T2 = R
  678.  
  679. *-------------------------------------------------------------------*
  680.  
  681.                 ; affectation s2 --> i1 ou r1
  682. _affsz  cmp.b    #2,([4,sp])
  683.     beq     _affsr
  684.                 ; affectation s2 --> i1
  685.  
  686. _affsi  link    a6,#0
  687.     movem.l    d0/a0,-(sp)
  688.     move.l    8(a6),d0    ; d0.l contient s2
  689.     move.l    12(a6),a0    ; a0 pointe sur i1
  690.     cmp.w    #2,2(a0)
  691.     bne.s     1$
  692.                 ; ici l1 = 2 (i1 = 0)
  693.     tst.l    d0
  694.     beq.s     4$
  695.                 ; ici s2 <> 0 (erreur)
  696.     move.l    #affer1,-(sp)
  697.     jsr     _err
  698.                 ; ici s2 = 0 ou l1 >= 3
  699. 1$      tst.l    d0
  700. 4$      bmi.s     2$
  701.                 ; ici s2 >= 0
  702.     bne.s     3$
  703.                 ; ici s2 = 0
  704.     move.l    #2,4(a0)
  705.     bra.s     affsif
  706.                 ; ici s2 > 0 et l1 >= 3
  707. 3$      move.l    #$1000003,4(a0)
  708.     move.l    d0,8(a0)
  709.     bra.s     affsif
  710.                 ; ici s2 < 0 et l1 >= 3
  711. 2$      move.l    #$ff000003,4(a0)
  712.     neg.l    d0
  713.     move.l    d0,8(a0)
  714. affsif  movem.l    (sp)+,d0/a0
  715.     unlk    a6
  716.     rts
  717.  
  718. *-------------------------------------------------------------------*
  719.  
  720.                 ; affectation i2 --> i1
  721.  
  722. _affii  link    a6,#0
  723.     movem.l    d0/a0-a1,-(sp)
  724.     move.l    8(a6),a1    ; a1 pointe sur i2
  725.     move.l    12(a6),a0    ; a0 pointe sur i1
  726.     cmp.l    a0,a1
  727.     beq.s     affiif
  728.                 ; ici a0 <> a1
  729.     move.w    2(a0),d0    ; d0.w contient l1
  730.     cmp.w    6(a1),d0
  731.     bcc.s     1$
  732.                 ; ici le2 > l1 (erreur)
  733.     move.l    #affer3,-(sp)
  734.     jsr     _err
  735.                 ; ici le2 <= l1
  736. 1$      move.w    6(a1),d0    ; d0.w contient le2
  737.     subq.w    #2,d0        ; d0.w contient L2
  738.     addq.l    #4,a0
  739.     addq.l    #4,a1
  740.                 ; copie de i2 dans i1
  741. 2$      move.l    (a1)+,(a0)+
  742.     dbra    d0,2$
  743. affiif  movem.l    (sp)+,d0/a0-a1
  744.     unlk    a6
  745.     rts
  746.  
  747. *-------------------------------------------------------------------*
  748.  
  749.                 ; conversion i --> long du C dans d0
  750.  
  751. _itos     move.l    a1,-(sp)
  752.     move.l    8(sp),a1    ; a1 pointe sur i2
  753.     cmp.w    #3,6(a1)
  754.     bls.s     1$
  755.                 ; ici l2 >= 4 (erreur)
  756.     move.l    #affer2,-(sp)
  757.     jsr     _err
  758.                 ; ici l2 <= 3
  759. 1$      beq.s     2$
  760.                 ; ici l2 = 2 (i2 = 0)
  761.     moveq    #0,d0
  762.     bra.s     itosf
  763.                 ; ici l2 = 3
  764. 2$      move.l    8(a1),d0    ; d0.l contient |i2|
  765.     cmp.l    #$80000000,d0
  766.     bcs.s     3$
  767.     beq.s     4$
  768.                 ; ici |i2| > 2^31 (erreur)
  769. 5$      move.l    #affer2,-(sp)
  770.     jsr     _err
  771.                 ; ici |i2| = 2^31
  772. 4$      tst.b    4(a1)
  773.     bpl.s     5$        ; si i2 = 2^31 erreur
  774.     bra.s     itosf        ; ici i2 = -2^31
  775.                 ; ici |i2| <= 2^31-1
  776. 3$      tst.w    4(a1)
  777.     bpl.s     itosf
  778.     neg.l    d0
  779. itosf     move.l    (sp)+,a1
  780.     rts
  781.  
  782. *-------------------------------------------------------------------*
  783.  
  784.                 ; conversion long du C --> i cree
  785.  
  786. _stoi     move.l    4(sp),d1
  787.     bne.s     1$
  788.     move.l    #2,d0
  789.     bsr     _geti
  790.     move.l    #2,4(a0)
  791.     bra.s     stoif
  792. 1$      move.l    #3,d0
  793.     bsr     _geti
  794.     tst.l    d1
  795.     bmi.s     2$
  796.     move.l    #$1000003,4(a0)
  797.     bra.s     3$
  798. 2$      move.l    #$ff000003,4(a0)
  799.     neg.l    d1
  800. 3$      move.l    d1,8(a0)
  801. stoif     move.l    a0,d0
  802.     rts
  803.  
  804. *-----------------------------------------------------------------------*
  805.  
  806.                 ; affectation s2 --> r1
  807.  
  808. _affsr  link    a6,#0
  809.     movem.l    d0-d1/a0,-(sp)
  810.     move.l    12(a6),a0    ; a0 pointe sur r1
  811.     move.l    8(a6),d0    ; d0.l contient s2
  812.     bne.s     1$
  813.                 ; ici s2 = 0
  814.     moveq    #0,d0
  815.     move.w    2(a0),d0
  816.     subq.w    #2,d0
  817.     lsl.l    #5,d0
  818.     neg.l    d0
  819.     add.l    #$800000,d0    ; d0.l contient fexp(0)
  820.     move.l    d0,4(a0)
  821.     clr.l    8(a0)
  822.     bra.s     affsrf
  823.                 ; ici s2 <> 0
  824. 1$      bpl.s     2$
  825.     neg.l    d0
  826.     move.b    #$ff,4(a0)    ; mise signe si s2 < 0
  827.     bra.s     3$
  828. 2$      move.b    #1,4(a0)    ; mise signe si s2 > 0
  829.                 ; ici s2 <> 0
  830. 3$      bfffo    d0{0:32},d1    ; d1.l recoit nb. de shifts (=k)
  831.     lsl.l    d1,d0        ; d0.l est norme
  832.     neg.w    d1
  833.     add.w    #31,d1
  834.     move.w    d1,6(a0)
  835.     move.b    #$80,5(a0)    ; mise exposant
  836.     move.l    d0,8(a0)    ; mise 1er long mot mantisse
  837.     moveq    #0,d0
  838.     move.w    2(a0),d1
  839.     subq.l    #3,d1        ; d1.w recoit L1-1
  840.     add.l    #12,a0        ; a0 pointe sur 2eme long mot mantisse
  841.     bra.s     4$
  842. 5$      move.l    d0,(a0)+
  843. 4$      dbra    d1,5$
  844. affsrf  movem.l    (sp)+,d0-d1/a0
  845.     unlk    a6
  846.     rts
  847.  
  848. *-------------------------------------------------------------------*
  849.  
  850.                 ; affectation i2 --> r1
  851.  
  852. _affir  link a6,#0
  853.     movem.l    d0-d6/a0-a1,-(sp)
  854.     move.l    8(a6),a1    ; a1 pointe sur i2
  855.     move.l    12(a6),a0    ; a0 pointe sur r1
  856.     tst.b    4(a1)
  857.     bne.s     1$
  858.                 ; ici i2 = 0
  859.     moveq    #0,d0
  860.     move.w    2(a0),d0
  861.     subq.w    #2,d0
  862.     lsl.l    #5,d0
  863.     neg.l    d0
  864.     add.l    #$800000,d0
  865.     move.l    d0,4(a0)
  866.     clr.l    8(a0)
  867.     bra.s     _affirf
  868.                 ; ici i2 <> 0
  869. 1$      move.l    8(a1),d0    ; d0.l contient 1er lg mot mantisse
  870.     bfffo    d0{0:32},d1    ; d1.l recoit nb de shifts (=k)
  871.     lsl.l    d1,d0        ; d0.l normalise
  872.     moveq    #0,d2
  873.     move.w    6(a1),d2
  874.     lsl.l    #5,d2
  875.     sub.l    d1,d2
  876.     add.l    #$7fffbf,d2    ; d2.l = fexp2 = 2^23 + L1*32 -1 -k
  877.     move.l    d2,4(a0)    ; mise exposant
  878.     move.b    4(a1),4(a0)    ; mise signe
  879.     move.w    6(a1),d4
  880.     subq.w    #3,d4        ; d4.w recoit L2-1 (compteur)
  881.     move.w    2(a0),d2
  882.     subq.w    #3,d2        ; d2.w recoit L1-1
  883.     add.l    #12,a1        ; a1 pointe sur 2eme lg mot mantisse i2
  884.     addq.l    #8,a0        ; a0 ponte sur 1er lg mot mantisse r1
  885.     moveq    #1,d6        ; masque
  886.     lsl.l    d1,d6
  887.     subq.l    #1,d6
  888.     sub.w    d4,d2        ; d2.w    recoit L1-L2
  889.     bpl.s     2$
  890.                 ; ici L1 < L2
  891.     add.w    d2,d4        ; d4.w    recoit L1-1
  892.     bra.s     2$
  893.                 ; copie mantisse shiftee dans r1
  894. 3$      move.l    (a1)+,d3
  895.     rol.l    d1,d3
  896.     move.l    d3,d5
  897.     and.l    d6,d3
  898.     add.l    d3,d0
  899.     move.l    d0,(a0)+
  900.     sub.l    d3,d5
  901.     move.l    d5,d0
  902. 2$      dbra    d4,3$
  903.     tst.w    d2
  904.     bmi.s     4$
  905.                 ; ici L1 > L2 completer par des 0
  906.     moveq    #0,d3
  907.     move.l    d0,(a0)+
  908.     bra.s     5$
  909. 6$      move.l    d3,(a0)+
  910. 5$      dbra    d2,6$
  911.     bra.s     _affirf
  912.                 ; ici L1 <= L2
  913. 4$      move.l    (a1)+,d3
  914.     rol.l    d1,d3
  915.     and.l    d6,d3
  916.     add.l    d3,d0
  917.     move.l    d0,(a0)+     ; mise a jour dernier lg mot
  918. _affirf  movem.l    (sp)+,d0-d6/a0-a1
  919.     unlk    a6
  920.     rts
  921.  
  922. *-------------------------------------------------------------------*
  923.  
  924.                 ; affectation r2 --> r1
  925.  
  926. _affrr  link    a6,#0
  927.     movem.l    d0-d1/a0-a1,-(sp)
  928.     move.l    8(a6),a1    ; a1 pointe sur r2
  929.     move.l    12(a6),a0    ; a0 pointe sur r1
  930.     cmp.l    a0,a1
  931.     beq.s     affrrf
  932.                 ; ici a0 <> a1
  933.     tst.b    4(a1)
  934.     bne.s     6$        
  935.                 ; ici r2 = 0
  936.     move.l    4(a1),4(a0)
  937.     clr.l    8(a0)
  938.     bra.s     affrrf
  939.                 ; ici r2 <> 0
  940. 6$      addq.l    #4,a0
  941.     addq.l    #4,a1
  942.     move.w    -2(a0),d0
  943.     move.w    -2(a1),d1    ; d0.w , d1.w contient l1,l2
  944.     cmp.w    d0,d1
  945.     bhi.s     1$
  946.                 ; ici l1 >= l2
  947.     sub.w    d1,d0        ; d0.w contient l1-l2
  948.     subq.w    #2,d1        ; d1.w    contient L2
  949. 3$      move.l    (a1)+,(a0)+    ; copie de r2 dans r1
  950.     dbra    d1,3$
  951.     moveq    #0,d1
  952.     bra.s     2$
  953.                 ; ici completer par des 0
  954. 4$      move.l    d1,(a0)+
  955. 2$      dbra    d0,4$
  956.     bra.s     affrrf
  957.                 ; ici l2 > l1
  958. 1$      subq.w    #2,d0        ; d0.w recoit L1 (compteur)
  959. 5$      move.l    (a1)+,(a0)+
  960.     dbra    d0,5$
  961. affrrf  movem.l    (sp)+,d0-d1/a0-a1
  962.     unlk    a6
  963.     rts
  964.  
  965. *-------------------------------------------------------------------*
  966.  
  967.                 ; affectation r2 --> s1
  968.  
  969. _affrs  move.l    #affer4,-(sp)
  970.     jsr     _err
  971.  
  972. *-------------------------------------------------------------------*
  973.  
  974.                 ; affectation r2 --> i1
  975.  
  976. _affri  move.l    #affer5,-(sp)
  977.     jsr     _err
  978.  
  979. *===================================================================*
  980. *                                    *
  981. *            Echange de deux nombres             *
  982. *                                    *
  983. *    entree : a7($4) contient l'adresse d'une zone z2 contemant    *
  984. *         n2 de type I ou R ; a7($8) contient l'adresse d'une*
  985. *         zone z1 contenant n1 de type I ou R        *
  986. *    sortie : a7($4) contient l'adresse de z2 contenant n1       *
  987. *         a7($8) contient l'adresse de z1 contenant n2       *
  988. *         d0,d1,a0,a1 sont sauvegardes            *
  989. *    remarque : message d'erreur si impossible ; type S interdit *
  990. *                                    *
  991. *===================================================================*
  992.  
  993. _mpexg  link    a6,#0
  994.     movem.l    d0-d4/a0-a2,-(sp)
  995.     move.l    8(a6),a2    ; a2 pointe sur n2
  996.     move.l    12(a6),a1    ; a1 pointe sur n1
  997.     move.b    (a2),d2
  998.     move.b    (a1),d1        ; d1.b et d2.b contiennent T1 et T2
  999.     cmp.b    d1,d2
  1000.     beq.s     1$
  1001.                 ; ici T1 <> T2 (erreur)
  1002.     move.l    #exger2,-(sp)
  1003.     jsr     _err
  1004.                 ; ici T1 = T2
  1005. 1$      move.l    (a1),d3        ; d3.l contient le 1er lgmot code de n1
  1006.     move.l    (a2),d4        ; d4.l contient le 1er lgmot code de n2
  1007.     cmp.w    d3,d4
  1008.     bne.s     2$
  1009.                 ; ici T1 = T2 et l1 = l2
  1010.     subq.w    #3,d3
  1011.     addq.l    #4,a1
  1012.     addq.l    #4,a2
  1013. 6$      move.l    (a2),d4
  1014.     move.l    (a1),(a2)+
  1015.     move.l    d4,(a1)+
  1016.     dbra    d3,6$
  1017.     bra.s     exgf
  1018.                 ; ici T1 = T2 et l1 <> l2
  1019. 2$      cmp.b    #1,d1
  1020.     bne.s     3$
  1021.                 ; ici T1 = T2 = I et l1 <> l2
  1022.     cmp.w    d3,d4
  1023.     ble.s     4$
  1024.     exg     a1,a2        ; si l2 > l1 echanger n1 et n2
  1025.     exg     d3,d4
  1026.                 ; ici l2 <= l1
  1027. 4$      cmp.w    6(a1),d4
  1028.     bpl.s     5$
  1029.                 ; ici l2 < le1 (erreur)
  1030.     move.l    #exger1,-(sp)
  1031.     jsr     _err
  1032.                 ; ici l2 >= le1
  1033. 5$      move.l    d4,d0
  1034.     bsr     _geti        ; allocation memoire pour copie de n2
  1035.     move.l    a0,-(sp)     ; empilage adresse copie
  1036.     move.l    a2,-(sp)     ; empilage adresse de n2
  1037.     bsr     _affii
  1038.     addq.l    #8,sp        ; depilage
  1039.     move.l    a2,-(sp)     ; empilage adresse n2
  1040.     move.l    a1,-(sp)     ; empilage adresse n1
  1041.     bsr     _affii
  1042.     addq.l    #8,sp        ; depilage
  1043.     move.l    a1,-(sp)     ; empilage adresse n1
  1044.     move.l    a0,-(sp)     ; empilage adresse copie
  1045.     bsr     _affii
  1046.     addq.l    #8,sp        ; depilage
  1047.     bsr     _giv         ; desallouer copie
  1048.     bra.s     exgf
  1049.                 ; ici T1 = T2 = R et l1 <> l2
  1050. 3$      move.l    d4,d0
  1051.     bsr     _getr        ; allocation memoire pour copie de n2
  1052.     move.l    a0,-(sp)     ; empilage adresse copie
  1053.     move.l    a2,-(sp)     ; empilage adresse n2
  1054.     bsr     _affrr
  1055.     addq.l    #8,sp
  1056.     move.l    a2,-(sp)     ; empilage adresse n2
  1057.     move.l    a1,-(sp)     ; empilage adresse n1
  1058.     bsr     _affrr
  1059.     addq.l    #8,sp
  1060.     move.l    a1,-(sp)     ; empilage adresse n1
  1061.     move.l    a0,-(sp)     ; empilage adresse copie
  1062.     bsr     _affrr
  1063.     addq.l    #8,sp
  1064.     bsr     _giv         ; desallouer copie
  1065. exgf     movem.l    (sp)+,d0-d4/a0-a2
  1066.     unlk    a6
  1067.     rts
  1068.  
  1069.  
  1070.  
  1071.  
  1072.  
  1073. *********************************************************************
  1074. *********************************************************************
  1075. ***                                   ***
  1076. ***         PROGRAMMES DE CHANGEMENT DE SIGNE          ***
  1077. ***                                   ***
  1078. *********************************************************************
  1079. *********************************************************************
  1080.  
  1081.  
  1082.  
  1083.  
  1084.  
  1085. *===================================================================*
  1086. *                                    *
  1087. *            Negation generale                *
  1088. *                                    *
  1089. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1090. *    sortie : d0 pointe sur n1 de type I ou R            *
  1091. *         contenant n1 = -n2 (zone creee)            *
  1092. *    interdit : type S                        *
  1093. *                                    *
  1094. *===================================================================*
  1095.  
  1096. _mpneg  cmp.b    #1,([4,sp])
  1097.     beq.s     _negi
  1098.     bra     _negr
  1099.  
  1100. *===================================================================*
  1101. *                                    *
  1102. *            Negation (par valeur)            *
  1103. *                                    *
  1104. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1105. *         a7($8) pointe sur n1 de type I ou R        *
  1106. *    sortie : la zone pointee par a7($8) contient -n2        *
  1107. *    interdit : type S                        *
  1108. *                                    *
  1109. *===================================================================*
  1110.  
  1111. _mpnegz move.l    4(sp),a0
  1112.     cmp.l    8(sp),a0
  1113.     bne.s     1$
  1114.     neg.b    4(a0)
  1115.     rts
  1116. 1$      move.l    4(sp),-(sp)
  1117.     bsr.s     _mpneg
  1118.     move.l    d0,-(sp)
  1119.     move.l    16(sp),4(sp)
  1120.     bsr     _mpaff
  1121.     move.l    (sp),a0
  1122.     addq.l    #8,sp
  1123.     bra     _giv
  1124.  
  1125. *===================================================================*
  1126. *                                    *
  1127. *            Negation                    *
  1128. *                                    *
  1129. *    entree : a7($4) contient un type S ou pointe sur un     *
  1130. *         type I ou R , soit n2                *
  1131. *    sortie : d0 pointe sur un type I ou R ,soit n1=-n2        *
  1132. *         (zone creee)                    *
  1133. *                                    *
  1134. *===================================================================*
  1135.  
  1136.                 ; negation s2 --> i1
  1137.  
  1138. _negs     move.l    4(sp),d1    ; d1.l recoit s2
  1139.     bne.s     1$
  1140.                 ; ici s2 = 0
  1141.     move.l    _gzero,d0
  1142.     rts
  1143.                 ; ici s2 <> 0
  1144. 1$      moveq    #3,d0
  1145.     bsr     _geti        ; allocation 3 longs mots
  1146.     move.l    a0,d0        ; d0 pointe sur resultat
  1147.     move.l    #$1000003,4(a0)
  1148.     neg.l    d1
  1149.     bpl.s     2$
  1150.                 ; ici s2 < 0
  1151.     move.b    #$ff,4(a0)
  1152.     neg.l    d1
  1153. 2$      move.l    d1,8(a0)
  1154. negsf     rts
  1155.  
  1156. *-------------------------------------------------------------------*
  1157.  
  1158.                 ; negation i2 --> i1
  1159.  
  1160. _negi     move.l    4(sp),a1    ; a1 pointe sur i2
  1161.     move.w    6(a1),d1
  1162.     move.l    d1,d0
  1163.     bsr     _geti
  1164.     move.l    a0,d0        ; d0 pointe sur -i2
  1165.     addq.l    #4,a0
  1166.     addq.l    #4,a1
  1167.     subq.w    #2,d1
  1168.                 ; recopie de i2
  1169. 1$      move.l    (a1)+,(a0)+
  1170.     dbra    d1,1$
  1171.     move.l    d0,a0
  1172.     neg.b    4(a0)
  1173.     rts
  1174.  
  1175. *-------------------------------------------------------------------*
  1176.  
  1177.                 ; negation r2 --> r1
  1178.  
  1179. _negr     move.l    4(sp),a1
  1180.     move.l    (a1),d1
  1181.     move.l    d1,d0
  1182.     bsr     _getr
  1183.     move.l    a0,d0
  1184.     addq.l    #4,a0
  1185.     addq.l    #4,a1
  1186.     subq.w    #2,d1
  1187. 1$      move.l    (a1)+,(a0)+
  1188.     dbra    d1,1$
  1189.     move.l    d0,a0
  1190.     neg.b    4(a0)
  1191.     rts
  1192.  
  1193. *===================================================================*
  1194. *                                    *
  1195. *            Valeur absolue generale             *
  1196. *                                    *
  1197. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1198. *    sortie : d0 pointe sur n1 de type I ou R avec n1=abs(n2)    *
  1199. *         de type I ou R (zone creee)            *
  1200. *    interdit : type S                        *
  1201. *                                    *
  1202. *===================================================================*
  1203.  
  1204. _mpabs  cmp.b    #1,([4,sp])
  1205.     beq.s     _absi
  1206.     bra     _absr
  1207.  
  1208. *===================================================================*
  1209. *                                    *
  1210. *            Valeur absolue (par valeur)         *
  1211. *                                    *
  1212. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1213. *         a7($8) pointe sur n1 de type I ou R        *
  1214. *    sortie : la zone pointee par a7($8) contient abs(n2)    *
  1215. *    interdit : type S                        *
  1216. *                                    *
  1217. *===================================================================*
  1218.  
  1219. _mpabsz move.l    4(sp),a0
  1220.     cmp.l    8(sp),a0
  1221.     bne.s     1$
  1222.     and.b    #1,4(a0)
  1223.     rts
  1224. 1$      move.l    4(sp),-(sp)
  1225.     bsr.s     _mpabs
  1226.     move.l    d0,-(sp)
  1227.     move.l    16(sp),4(sp)
  1228.     bsr     _mpaff
  1229.     move.l    (sp),a0
  1230.     addq.l    #8,sp
  1231.     bra     _giv
  1232.  
  1233. *===================================================================*
  1234. *                                    *
  1235. *            Valeur absolue                *
  1236. *                                    *
  1237. *    entree : a7($4) contient ou pointe sur n2            *
  1238. *    sortie : d0 pointe sur i1 ou r1 (zone creee)        *
  1239. *                                    *
  1240. *===================================================================*
  1241.  
  1242.                 ; valeur absolue s2 --> i1
  1243.  
  1244. _abss    move.l    4(sp),d1    ; d1.l contient s2
  1245.     bne.s     1$
  1246.                 ; ici s2 = 0
  1247.     move.l    _gzero,d0
  1248.     rts
  1249.                 ; ici s2 <> 0
  1250. 1$      moveq    #3,d0
  1251.     bsr     _geti
  1252.     move.l    a0,d0
  1253.     move.l    #$1000003,4(a0)
  1254.     tst.l    d1
  1255.     bpl.s     2$
  1256.     neg.l    d1
  1257. 2$      move.l    d1,8(a0)
  1258.     rts
  1259.  
  1260. *-------------------------------------------------------------------*
  1261.  
  1262.                 ; valeur absolue i2 --> i1
  1263.  
  1264. _absi     move.l    4(sp),a1    ; a1 pointe sur i2
  1265.     move.w    6(a1),d1
  1266.     move.w    d1,d0
  1267.     bsr     _geti
  1268.     move.l    a0,d0        ; d0 pointe sur resultat
  1269.     cmp.w    #2,d1
  1270.     bne.s     1$
  1271.                 ; ici i2 = 0
  1272.     move.l    #2,4(a0)
  1273.     bra.s     absif
  1274.                 ; ici i2 <> 0
  1275. 1$      move.l    #$1000000,4(a0)
  1276.     move.w    d1,6(a0)
  1277.     addq.l    #8,a1
  1278.     addq.l    #8,a0
  1279.     subq.w    #3,d1
  1280. 2$      move.l    (a1)+,(a0)+
  1281.     dbra    d1,2$
  1282. absif     rts
  1283.  
  1284. *-------------------------------------------------------------------*
  1285.  
  1286.                 ; valeur absolue r2 --> r1
  1287.  
  1288. _absr     move.l    4(sp),a1
  1289.     move.w    2(a1),d1
  1290.     move.w    d1,d0
  1291.     bsr     _getr
  1292.     move.l    a0,d0        ; a0 pointe sur resultat
  1293.     subq.w    #2,d1
  1294.     addq.l    #4,a1
  1295.     addq.l    #4,a0
  1296. 1$      move.l    (a1)+,(a0)+
  1297.     dbra    d1,1$
  1298.     move.l    d0,a0
  1299.     tst.b    4(a0)
  1300.     bpl.s     absrf
  1301.     neg.b    4(a0)
  1302. absrf     rts
  1303.  
  1304. *********************************************************************
  1305. *********************************************************************
  1306. ***                                   ***
  1307. ***             VALUATION                  ***
  1308. ***                                   ***
  1309. *********************************************************************
  1310. *********************************************************************
  1311.  
  1312.  
  1313.  
  1314.  
  1315.  
  1316. *===================================================================*
  1317. *                                    *
  1318. *    Valuation 2-adique d'un entier court ou d'un entier     *
  1319. *                                    *
  1320. *    entree : a7($4) contient s1 de type S ou pointe sur i1 de    *
  1321. *         type I                         *
  1322. *    sortie : d0.l contient k tel que : k>=0 , n1=2^k*n2 ,    *
  1323. *         avec n2 et 2 premiers entre eux ; si n1=0 , alors    *
  1324. *         d0.l contient -1.                    *
  1325. *    remarque : type R interdit                    *
  1326. *                                    *
  1327. *===================================================================*
  1328.  
  1329.                 ; valuation de s1 de type S
  1330.  
  1331. _vals     link    a6,#0
  1332.     move.l    d2,-(sp)
  1333.     moveq    #-1,d0
  1334.     move.l    8(a6),d1    ; d1.l contient s1
  1335.     beq.s     valsf
  1336.     moveq    #0,d0
  1337.     tst.w    d1
  1338.     bne.s     1$
  1339.     add.l    #16,d0
  1340.     swap    d1
  1341. 1$      tst.b    d1
  1342.     bne.s     2$
  1343.     addq.l    #8,d0
  1344.     lsr.l    #8,d1
  1345. 2$      move.l    d1,d2
  1346.     and.l    #15,d2
  1347.     bne.s     3$
  1348.     addq.l    #4,d0
  1349.     lsr.l    #4,d1
  1350. 3$      move.l    d1,d2
  1351.     and.l    #3,d2
  1352.     bne.s     4$
  1353.     addq.l    #2,d0
  1354.     lsr.l    #2,d1
  1355. 4$      btst    #0,d1
  1356.     bne.s     valsf
  1357.     addq.l    #1,d0
  1358. valsf     move.l    (sp),d2
  1359.     unlk    a6
  1360.     rts
  1361.  
  1362.                 ; valuation de i1 de type I
  1363.  
  1364. _vali     link    a6,#0
  1365.     move.l    d2,-(sp)
  1366.     move.l    8(a6),a1    ; a1 pointe sur i1
  1367.     moveq    #-1,d0
  1368.     tst.b    4(a1)
  1369.     beq.s     valif
  1370.                 ; ici i1 <> 0
  1371.     move.w    6(a1),d1    ; d1.w contient L1+2
  1372.     lea     0(a1,d1.w*4),a1 ; a1 pointe fin mantisse de i1
  1373.     move.l    #$ffff,d0
  1374. 5$      tst.l    -(a1)
  1375.     dbne    d0,5$
  1376.     not.w    d0
  1377.     lsl.l    #5,d0        ; d0.l contient 32*nb.de lgmots nuls
  1378.     move.l    (a1),d1        ; a droite de i1 et a1 pointe 1er lgmot
  1379.     tst.w    d1        ; non nul (qui existe car i1 <> 0)
  1380.     bne.s     1$
  1381.     add.l    #16,d0
  1382.     swap    d1
  1383. 1$      tst.b    d1
  1384.     bne.s     2$
  1385.     addq.l    #8,d0
  1386.     lsr.l    #8,d1
  1387. 2$      move.l    d1,d2
  1388.     and.l    #15,d2
  1389.     bne.s     3$
  1390.     addq.l    #4,d0
  1391.     lsr.l    #4,d1
  1392. 3$      move.l    d1,d2
  1393.     and.l    #3,d2
  1394.     bne.s     4$
  1395.     addq.l    #2,d0
  1396.     lsr.l    #2,d1
  1397. 4$      btst    #0,d1
  1398.     bne.s     valif
  1399.     addq.l    #1,d0
  1400. valif     move.l    (sp),d2
  1401.     unlk    a6
  1402.     rts
  1403.  
  1404.  
  1405.  
  1406.  
  1407.  
  1408. *********************************************************************
  1409. *********************************************************************
  1410. ***                                   ***
  1411. ***             PROGRAMMES DE SHIFT               ***
  1412. ***                                   ***
  1413. *********************************************************************
  1414. *********************************************************************
  1415.  
  1416.  
  1417.  
  1418.  
  1419.  
  1420. *===================================================================*
  1421. *                                    *
  1422. *            Shift general                *
  1423. *                                    *
  1424. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1425. *         a7($8) contient k = nombre de shifts        *
  1426. *    sortie : d0 pointe sur n1 de type I ou R            *
  1427. *         contenant n1 = 2^k * n2 (zone creee)        *
  1428. *    interdit : type S                        *
  1429. *                                    *
  1430. *===================================================================*
  1431.  
  1432. _mpshift cmp.b    #1,([4,sp])
  1433.     beq     _shifti
  1434.     bra     _shiftr
  1435.  
  1436. *===================================================================*
  1437. *                                    *
  1438. *            Shift (par valeur)                *
  1439. *                                    *
  1440. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1441. *         a7($8) contient le nombre de shifts (=k)        *
  1442. *         a7($12) pointe sur n1 de type I ou R        *
  1443. *    sortie : la zone pointee par a7($12) contient 2^k * n2    *
  1444. *    interdit : type S                        *
  1445. *                                    *
  1446. *===================================================================*
  1447.  
  1448. _mpshiftz move.l    4(sp),a0
  1449.     cmp.l    12(sp),a0
  1450.     bne.s     1$
  1451.     cmp.b    #2,(a0)
  1452.     bne.s     1$
  1453.     move.l    4(a0),d0
  1454.     and.l    #$ffffff,d0
  1455.     add.l    8(sp),d0
  1456.     bvs     shier
  1457.     cmp.l    #$1000000,d0
  1458.     bcc     shier
  1459.     tst.l    d0
  1460.     bmi     shier
  1461.     move.w    d0,6(a0)
  1462.     swap    d0
  1463.     move.b    d0,5(a0)
  1464.     rts
  1465. 1$      move.l    8(sp),-(sp)
  1466.     move.l    8(sp),-(sp)
  1467.     bsr.s     _mpshift
  1468.     move.l    d0,(sp)
  1469.     move.l    20(sp),4(sp)
  1470.     bsr     _mpaff
  1471.     move.l    (sp),a0
  1472.     addq.l    #8,sp
  1473.     bra     _giv
  1474.  
  1475. *===================================================================*
  1476. *                                    *
  1477. *        Shift d'un entier court = entier                    *
  1478. *                                    *
  1479. *    entree : a7($4) contient s2 de type S            *
  1480. *         a7($8) contient k = nombre de shifts        *
  1481. *    sortie : d0 pointe sur i1 de type I             *
  1482. *         avec i1 = 2^k * s2 (zone creee)            *
  1483. *                                    *
  1484. *===================================================================*
  1485.  
  1486. _shifts link    a6,#-12
  1487.     move.l    12(a6),-(sp)    ; empilage k
  1488.     move.l    8(a6),d0    ; d0.l contient s2
  1489.     bne.s     1$
  1490.                 ; ici s2 = 0
  1491.     move.l    #$1000002,-12(a6)
  1492.     move.l    #2,-8(a6)    ; creation de 0 en var. locale
  1493.     bra.s     3$
  1494.                 ; ici s2 <> 0
  1495. 1$      move.l    #$1000003,-12(a6)
  1496.     move.l    #$1000003,-8(a6)
  1497.     tst.l    d0
  1498.     bpl.s     2$
  1499.     neg.l    d0
  1500.     move.b    #$ff,-8(a6)
  1501. 2$      move.l    d0,-4(a6)    ; creation de s2 en var. locale
  1502. 3$      pea     -12(a6)    ; empilage adresse var. locale
  1503.     bsr.s     _shifti
  1504.     unlk    a6
  1505.     rts
  1506.  
  1507. *===================================================================*
  1508. *                                    *
  1509. *            Shift entier = entier            *
  1510. *                                    *
  1511. *    entree : a7($4) pointe sur i2 de type I             *
  1512. *         a7($8) contient k = nombre de shifts        *
  1513. *    sortie : d0 pointe sur i1 de type I             *
  1514. *         avec i1 = 2^k * i2 (zone creee)            *
  1515. *                                    *
  1516. *===================================================================*
  1517.  
  1518. _shifti link    a6,#0
  1519.     movem.l    d2-d7/a2-a3,-(sp)
  1520.     move.l    8(a6),a2    ; a2 pointe sur i2
  1521.     move.l    12(a6),d7    ; d7.l contient k
  1522.     bne.s     1$
  1523.                 ; ici k = 0
  1524.     move.w    2(a2),d0
  1525.     bsr     _geti
  1526.     move.l    a0,a3    ; sauvegarde adresse resultat
  1527.     subq.w    #2,d0
  1528.     addq.l    #4,a0
  1529.     addq.l    #4,a2
  1530. 24$     move.l    (a2)+,(a0)+
  1531.     dbra    d0,24$
  1532.     bra     shiftif
  1533.                 ; ici k <> 0
  1534. 1$      tst.b    4(a2)
  1535.     bne.s     2$
  1536.                 ; ici i1 = 0
  1537. 6$      moveq    #2,d0
  1538.     bsr     _geti
  1539.     move.l    a0,a3        ; sauvegarde adresse resultat
  1540.     move.l    #2,4(a0)
  1541.     bra     shiftif
  1542.                 ; ici k <> 0 et i2 <> 0
  1543. 2$      moveq    #0,d0
  1544.     move.w    6(a2),d0    ; d0.w contient L2+2
  1545.     cmp.l    #1,d7
  1546.     bne.s     3$
  1547.                 ; ici k = 1 et i2 <> 0
  1548.     move.l    8(a2),d5
  1549.     btst    #31,d5
  1550.     beq.s     4$
  1551.                 ; ici d5 >= 2^31
  1552.     addq.w    #1,d0        ; demander 1 lgmot supplementaire
  1553.     cmp.w    #$8000,d0
  1554.     bcs.s     4$
  1555.                 ; ici debordement
  1556. 18$     move.l    #shier1,-(sp)
  1557.     jsr     _err
  1558.                 ; ici k = 1 et i2 <> 0
  1559. 4$      bsr     _geti
  1560.     move.l    a0,a3        ; sauvegarde adresse resultat
  1561.     move.w    2(a0),6(a0)    ; mise longueur effective
  1562.     move.b    4(a2),4(a0)    ; mise signe
  1563.     lea     0(a0,d0.w*4),a1 ; a1 pointe fin resultat
  1564.     lea     0(a2,d0.w*4),a2
  1565.     btst    #31,d5
  1566.     beq.s     5$
  1567.     subq.w    #4,a2        ; ici a2 pointe fin i2
  1568.     move.l    #1,8(a0)
  1569.     subq.w    #1,d0
  1570. 5$      subq.w    #3,d0        ; d0.w compteur
  1571. 7$      move.l    -(a2),d1
  1572.     roxl.l    #1,d1
  1573.     move.l    d1,-(a1)
  1574.     dbra    d0,7$
  1575.     bra     shiftif
  1576.                 ; ici k <> 1 et i2 <> 0
  1577. 3$      cmp.l    #-1,d7
  1578.     bne.s     8$
  1579.                 ; ici k = -1 et i2 <> 0
  1580.     cmp.l    #1,8(a2)
  1581.     bhi.s     9$
  1582.     subq.w    #1,d0
  1583.     cmp.w    #2,d0
  1584.     beq     6$        ; si i1 = 0
  1585. 9$      bsr     _geti
  1586.     move.l    a0,a3
  1587.     move.b    4(a2),4(a0)    ; mise signe
  1588.     move.w    2(a0),6(a0)    ; mise longueur effective
  1589.     addq.l    #8,a0
  1590.     addq.l    #8,a2
  1591.     move.w    -2(a2),d0
  1592.     subq.w    #3,d0        ; d0.w compteur
  1593.     move.l    (a2)+,d1
  1594.     lsr.l    #1,d1
  1595.     beq.s     10$
  1596.     move.l    d1,(a0)+
  1597.     bra.s     10$
  1598. 11$     move.l    (a2)+,d1
  1599.     roxr.l    #1,d1
  1600.     move.l    d1,(a0)+
  1601. 10$     dbra    d0,11$
  1602.     bra     shiftif
  1603.                 ; ici k<>0,k<>1,k<>-1 et i2<>0
  1604. 8$      tst.l    d7
  1605.     bpl.s     12$
  1606.                 ; ici shift a droite : k < -1 et i2 <> 0
  1607.     neg.l    d7        ; d7.l contient /k/
  1608.     move.l    d7,d4
  1609.     lsr.l    #5,d4        ; d4.l contient r
  1610.     and.l    #31,d7        ; k=32*q+r; d7.l contient q
  1611.     sub.w    d4,d0        ; d0.w contient L2+2-q
  1612.     cmp.w    #2,d0
  1613.     bls     2$        ; si r1 = 0
  1614.     move.l    8(a2),d4
  1615.     lsr.l    d7,d4
  1616.     bne.s     13$
  1617.                 ; ici on perd un lgmot de resultat
  1618.     subq.w    #1,d0
  1619.     cmp.w    #2,d0
  1620.     beq     6$        ; si r1 = 0
  1621. 13$     bsr     _geti        ; allocation memoire pour resultat
  1622.     move.l    a0,a3
  1623.     move.b    4(a2),4(a0)    ; mise signe
  1624.     move.w    2(a0),6(a0)    ; mise longueur effective
  1625.     lea     0(a2,d0.w*4),a2 ; a2 pointe ou il faut !
  1626.     lea     0(a0,d0.w*4),a1 ; a1 pointe fin resultat
  1627.     tst.l    d4
  1628.     beq.s     14$
  1629.     move.l    d4,8(a0)
  1630.     subq.w    #3,d0        ; d0.w compteur
  1631.     bra.s     15$
  1632. 14$     addq.l    #4,a2
  1633.     subq.w    #2,d0
  1634. 15$     moveq    #-1,d6
  1635.     lsr.l    d7,d6        ; masque de shift
  1636.     move.l    -(a2),d4
  1637.     lsr.l    d7,d4
  1638.     bra.s     16$
  1639. 17$     move.l    -(a2),d2     ; boucle de shift
  1640.     ror.l    d7,d2
  1641.     move.l    d2,d3
  1642.     and.l    d6,d3
  1643.     sub.l    d3,d2
  1644.     add.l    d2,d4
  1645.     move.l    d4,-(a1)
  1646.     move.l    d3,d4
  1647. 16$     dbra    d0,17$
  1648.     bra.s     shiftif
  1649.                 ; ici shift a gauche : k > 1 et i2 <> 0
  1650. 12$     move.l    d7,d4
  1651.     and.l    #31,d7        ; d7.l contient q
  1652.     lsr.l    #5,d4        ; d4.l contient r (k=32*q+r)
  1653.     add.l    d4,d0        ; d0.l contient L2+2+q
  1654.     cmp.w    #$7fff,d0
  1655.     bcc     18$
  1656.     moveq    #-1,d6
  1657.     lsl.l    d7,d6
  1658.     not.l    d6        ; masque de shift
  1659.     move.l    8(a2),d2
  1660.     rol.l    d7,d2
  1661.     move.l    d2,d3
  1662.     and.l    d6,d3
  1663.     beq.s     19$
  1664.     addq.w    #1,d0        ; un long mot supplementaire
  1665. 19$     bsr     _geti
  1666.     move.l    a0,a3
  1667.     move.l    2(a0),6(a0)    ; mise longueur effective
  1668.     move.b    4(a2),4(a0)    ; mise signe
  1669.     addq.l    #8,a0
  1670.     tst.l    d3
  1671.     beq.s     20$
  1672.     move.l    d3,(a0)+
  1673. 20$     sub.l    d3,d2
  1674.     move.l    d2,d5
  1675.     move.w    6(a2),d0
  1676.     add.l    #12,a2
  1677.     subq.w    #3,d0        ; d0.w contient compteur
  1678.     bra.s     21$
  1679. 22$     move.l    (a2)+,d2
  1680.     rol.l    d7,d2
  1681.     move.l    d2,d3
  1682.     and.l    d6,d3
  1683.     sub.l    d3,d2
  1684.     add.l    d3,d5
  1685.     move.l    d5,(a0)+
  1686.     move.l    d2,d5
  1687. 21$     dbra    d0,22$
  1688.     move.l    d5,(a0)+
  1689.     moveq    #0,d0
  1690.     bra.s     23$
  1691. 25$     move.l    d0,(a0)+
  1692. 23$     dbra    d4,25$
  1693. shiftif move.l    a3,d0        ; d0 pointe sur resultat
  1694.     movem.l    (sp)+,d2-d7/a2-a3
  1695.     unlk    a6
  1696.     rts
  1697.  
  1698. *===================================================================*
  1699. *                                    *
  1700. *            Shift reel = reel                *
  1701. *                                    *
  1702. *    entree : a7($4) pointe sur r2 de type R             *
  1703. *         a7($8) contient k = nombre de shifts        *
  1704. *    sortie : d0 pointe sur r1 de type R             *
  1705. *         avec r1 = 2^k * r2 zone creee)             *
  1706. *                                    *
  1707. *===================================================================*
  1708.  
  1709. _shiftr link    a6,#0
  1710.     movem.l    d2/a2-a3,-(sp)
  1711.     move.l    8(a6),a2    ; a2 pointe sur r2
  1712.     move.l    12(a6),d2    ; d2.l contient k
  1713.     bne.s     1$
  1714.                 ; ici k = 0
  1715.     move.w    2(a2),d0
  1716.     bsr     _getr
  1717.     move.l    a0,a3
  1718.     subq.w    #2,d0
  1719.     addq.l    #4,a0
  1720.     addq.l    #4,a2
  1721. 4$      move.l    (a2)+,(a0)+
  1722.     dbra    d0,4$        ; boucle de recopie de r2 dans r1
  1723.     bra.s     shiftrf
  1724.                 ; ici k <> 0
  1725. 1$      move.l    4(a2),d1
  1726.     and.l    #$ffffff,d1
  1727.     add.l    d2,d1        ; d1.l contient fexp2 + k
  1728.     bvc.s     sh
  1729.                 ; ici debordement
  1730. shier     move.l    #shier2,-(sp)
  1731.     jsr     _err
  1732.                 ; ici k + fexp2 <= 2^31 -1
  1733. sh      cmp.l    #$1000000,d1
  1734.     bcc.s     shier        ; si k + fexp2 >= 2^24
  1735.     tst.l    d1
  1736.     bmi.s     shier        ; si k + fexp2 < 0
  1737.     move.w    2(a2),d0
  1738.     bsr     _getr        ; allocation memoire pour resultat
  1739.     move.l    a0,a3
  1740.     move.l    d1,4(a0)    ; mise exposant
  1741.     move.b    4(a2),4(a0)    ; mise signe
  1742.     addq.l    #8,a0
  1743.     addq.l    #8,a2
  1744.     subq.w    #3,d0
  1745. 5$      move.l    (a2)+,(a0)+
  1746.     dbra    d0,5$
  1747. shiftrf move.l    a3,d0        ; d0 pointe sur resultat
  1748.     movem.l    (sp)+,d2/a2-a3
  1749.     unlk    a6
  1750.     rts
  1751.  
  1752.  
  1753.  
  1754.  
  1755.  
  1756. *********************************************************************
  1757. *********************************************************************
  1758. ***                                   ***
  1759. ***             PROGRAMMES DE PARTIE ENTIERE          ***
  1760. ***                                   ***
  1761. *********************************************************************
  1762. *********************************************************************
  1763.  
  1764.  
  1765.  
  1766.  
  1767.  
  1768. *===================================================================*
  1769. *                                    *
  1770. *        Fausse partie entiere (trunc)            *
  1771. *                                    *
  1772. *    entree : a7($4) pointe sur n1 de type I ou de type R    *
  1773. *    sortie : d0 pointe sur i1 de type I (zone creee)        *
  1774. *    calcul : si r1 >= 0 , i1 est la partie entiere        *
  1775. *         si r1 < 0 , i1 = - Ent (-r1)            *
  1776. *    remarque : type S interdit                    *
  1777. *                                    *
  1778. *===================================================================*
  1779.  
  1780. _mptrunc link    a6,#0
  1781.     movem.l    d2-d6/a2-a4,-(sp)
  1782.     move.l    8(a6),a1    ; a1 pointe sur n1
  1783.     cmp.b    #1,(a1)
  1784.     bne.s     5$
  1785.                 ; ici n1 est de type I
  1786.     move.w    6(a1),d0
  1787.     bsr     _geti
  1788.     move.l    a0,a4
  1789.     subq.w    #2,d0
  1790.     addq.l    #4,a0
  1791.     addq.l    #4,a1
  1792. 7$      move.l    (a1)+,(a0)+
  1793.     dbra    d0,7$
  1794.     bra     truncf
  1795.                 ; ici n1 est de type R
  1796. 5$      move.l    4(a1),d3    ; d3.l contient second long mot code r1
  1797.     move.l    d3,d0
  1798.     and.l    #$ffffff,d0    ; d0.l contient fexp1
  1799.     sub.l    #$800000,d0    ; d0.l contient exp1
  1800.     bpl.s     1$
  1801.                 ; ici exp1 < 0 (trunc r1 = 0)
  1802.     moveq    #2,d0
  1803.     bsr     _geti
  1804.     move.l    a0,a4
  1805.     move.l    #$2,4(a0)
  1806.     bra.s     truncf
  1807.                 ; ici exp1 >= 0
  1808. 1$      move.l    d0,d2        ; d2.l    contient exp1
  1809.     lsr.l    #5,d0        ; d0.l contient exp1 div 32 = q
  1810.     addq.l    #3,d0        ; d0.l    contient le(i1)
  1811.     cmp.l    #$7fff,d0
  1812.     bls.s     2$
  1813.                 ; ici le(i1)> 2^15 : erreur
  1814.     move.l    #truer1,-(sp)
  1815.     jsr     _err
  1816.                 ; ici le(i1)<=2^15
  1817. 2$      bsr     _geti        ; allocation q+3 longs mots pour i1
  1818.     move.l    a0,a4
  1819.     move.w    d0,6(a0)    ; mise longueur effective de i1
  1820.     move.b    4(a1),4(a0)    ; mise signe de i1
  1821.     move.l    a0,a3        ; sauvegarde adresse i1
  1822.     addq.l    #8,a0
  1823.     addq.l    #8,a1        ; a0,a1 pointent sur mantisses i1,r1
  1824.     move.w    -6(a1),d1    ; d1.w contient l(r1)
  1825.     sub.w    d0,d1        ; d1.w contient l(r1)-le(i1)
  1826.     bpl.s     3$
  1827.                 ; ici l(r1)<le(i1) : erreur
  1828.     move.l    #truer2,-(sp)
  1829.     jsr     _err
  1830.                 ; ici l(r1)>=le(i1)
  1831. 3$      subq.w    #3,d0        ; d0.w contient l(i1)-1 (compteur)
  1832.     addq.b    #1,d2        ; d2.b contient exp1+1 (derniers bits)
  1833.     and.b    #31,d2        ; d2.b contient exp1+1 mod 32
  1834.     bne.s     4$
  1835.                 ; ici pas de shift a faire
  1836. 8$      move.l    (a1)+,(a0)+
  1837.     dbra    d0,8$        ; recopie des mantisses
  1838.     bra.s     truncf
  1839.                 ; ici d2.b shifts a faire
  1840. 4$      moveq    #1,d6
  1841.     lsl.l    d2,d6
  1842.     subq.l    #1,d6        ; masque de shift
  1843.     moveq    #0,d5
  1844. 6$      move.l    (a1)+,d3     ; boucle de shift
  1845.     rol.l    d2,d3
  1846.     move.l    d3,d4
  1847.     and.l    d6,d4
  1848.     sub.l    d4,d3
  1849.     add.l    d5,d4
  1850.     move.l    d4,(a0)+
  1851.     move.l    d3,d5
  1852.     dbra    d0,6$
  1853. truncf  move.l    a4,d0        ; d0 pointe sur resultat
  1854.     movem.l    (sp)+,d2-d6/a2-a4
  1855.     unlk    a6
  1856.     rts
  1857.  
  1858. *===================================================================*
  1859. *                                    *
  1860. *        Fausse partie entiere (par valeur)            *
  1861. *                                    *
  1862. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1863. *         a7($8) pointe sur n1 de type I ou R        *
  1864. *    sortie : la zone pointee par a7($8) contient trunc(n2)    *
  1865. *    interdit : type S                        *
  1866. *                                    *
  1867. *===================================================================*
  1868.  
  1869. _mptruncz move.l    4(sp),-(sp)
  1870.     bsr     _mptrunc
  1871.     move.l    12(sp),(sp)
  1872.     move.l    d0,-(sp)
  1873.     bsr     _mpaff
  1874.     move.l    d0,a0
  1875.     addq.l    #8,sp
  1876.     bra     _giv
  1877.  
  1878. *===================================================================*
  1879. *                                    *
  1880. *        Partie entiere ( max { n <= x} )            *
  1881. *                                    *
  1882. *    entree : a7($4) pointe sur n1 de type I ou R        *
  1883. *    sortie : d0 pointe sur i1 de type I (zone creee)        *
  1884. *    remarque : type S interdit                    *
  1885. *                                    *
  1886. *===================================================================*
  1887.  
  1888. _mpent  link    a6,#0
  1889.     movem.l    d2-d6/a2-a4,-(sp)
  1890.     move.l    8(a6),a1    ; a1 pointe sur n1
  1891.     cmp.b    #1,(a1)
  1892.     bne.s     1$
  1893.                 ; ici n1 est de type I
  1894.     move.w    6(a1),d0          ; d0.w recoit le1
  1895.     bsr     _geti
  1896.     move.l    a0,a4        ; sauvegarde adresse resultat
  1897.     subq.w    #2,d0
  1898.     addq.l    #4,a0
  1899.     addq.l    #4,a1
  1900. 6$      move.l    (a1)+,(a0)+
  1901.     dbra    d0,6$
  1902.     bra     entf
  1903.                 ; ici n1 est de type R
  1904. 1$      tst.b    4(a1)
  1905.     blt.s     2$
  1906.                 ; ici n1 >= 0 (ent(n1)=trunc(n1))
  1907.     move.l    8(a6),-(sp)     ; empilage adresse n1
  1908.     bsr     _mptrunc
  1909.     move.l    d0,a4        ; sauvegarde adresse resultat
  1910.     addq.l    #4,sp
  1911.     bra     entf
  1912.                 ; ici n1 < 0
  1913. 2$      move.l    4(a1),d3
  1914.     and.l    #$ffffff,d3
  1915.     sub.l    #$800000,d3    ; d3.l contient exp1
  1916.     bpl.s     3$
  1917.                 ; ici exp1 < 0 (ent(n1)=-1)
  1918.     moveq    #3,d0
  1919.     bsr     _geti
  1920.     move.l    a0,a4        ; sauvegarde adresse resultat
  1921.     move.l    #$ff000003,4(a0)
  1922.     move.l    #1,8(a0)
  1923.     bra.s     entf
  1924.                 ; ici exp1 >= 0
  1925. 3$      move.l    _avma,a3    ; ancien __avma dans var. locale
  1926.     move.l    8(a6),-(sp)     ; empilage adresse n1
  1927.     bsr     _mptrunc
  1928.     move.l    d0,a4        ; sauvegarde adresse res. provisoire
  1929.     addq.l    #4,sp        ; depilage des parametres
  1930.     move.l    d3,d1        ; d1.l contient exp1
  1931.     lsr.l    #5,d3        ; d3.l contient exp1 div 32 = q
  1932.     and.l    #31,d1        ; d1.l contient exp1 mod 32 = r
  1933.     move.l    8(a6),a1
  1934.     lea     8(a1,d3.l*4),a2 ; a2 pointe q+1eme lgmot mantisse
  1935.     move.l    #$80000000,d6    ; d6.l contient 2^31
  1936.     lsr.l    d1,d6        ; d6.l    contient 2^(31-r)
  1937.     subq.l    #1,d6        ; masque:0...01...1 avec r+1 zeros
  1938.     moveq    #0,d2
  1939.     move.w    2(a1),d2
  1940.     subq.l    #3,d2        ; d2.l contient L1-1
  1941.     sub.l    d3,d2        ; d2.l contient L1-1-q
  1942.     move.l    (a2)+,d5     ; d5.l contient le q+1 eme lgmot
  1943.     and.l    d6,d5
  1944.     beq.s     4$
  1945.     bra.s     5$
  1946. 7$      tst.l    (a2)+
  1947. 4$      dbne    d2,7$
  1948.     bne.s     5$
  1949.                 ; ici tous les lgmots sont nuls
  1950.     bra.s     entf
  1951.                 ; ici un au moins non nul
  1952. 5$      move.l    a4,-(sp)     ; empilage trunc(n1)
  1953.     move.l    #$ffffffff,-(sp) ; empilage -1
  1954.     bsr     _addsi        ; calcul de trunc(n1)-1
  1955.     addq.l    #8,sp        ; depilage
  1956.     move.l    a4,a1        ; a1 pointe sur trunc(n1)
  1957.     move.l    a3,a4        ; a4 contient __avma ancien
  1958.     move.l    d0,a0        ; a0 pointe sur resultat (res)
  1959.     move.w    2(a0),d0    ; d0.w contient l(res)
  1960.     subq.w    #1,d0        ; d0.w contient l-1
  1961. 8$      move.l    -(a1),-(a4)
  1962.     dbra    d0,8$        ; transfert du resultat ds pile PARI
  1963.     move.l    a4,_avma    ; mise a jour pile PARI
  1964. entf     move.l    a4,d0        ; d0 pointe sur resultat
  1965.     movem.l    (sp)+,d2-d6/a2-a4
  1966.     unlk    a6
  1967.     rts
  1968.  
  1969. *===================================================================*
  1970. *                                    *
  1971. *            Partie entiere (par valeur)         *
  1972. *                                    *
  1973. *    entree : a7($4) pointe sur n2 de type I ou R        *
  1974. *         a7($8) pointe sur n1 de type I ou R        *
  1975. *    sortie : la zone pointee par a7($8) contient ent(n2)    *
  1976. *    interdit : type S                        *
  1977. *                                    *
  1978. *===================================================================*
  1979.  
  1980. _mpentz move.l    4(sp),-(sp)
  1981.     bsr     _mpent
  1982.     move.l    12(sp),(sp)
  1983.     move.l    d0,-(sp)
  1984.     bsr     _mpaff
  1985.     move.l    d0,a0
  1986.     addq.l    #8,sp
  1987.     bra     _giv
  1988.  
  1989.  
  1990.  
  1991.  
  1992.  
  1993. *********************************************************************
  1994. *********************************************************************
  1995. ***                                   ***
  1996. ***         PROGRAMMES DE COMPARAISON              ***
  1997. ***                                   ***
  1998. *********************************************************************
  1999. *********************************************************************
  2000.  
  2001.  
  2002.  
  2003.  
  2004.  
  2005. *===================================================================*
  2006. *                                    *
  2007. *            Comparaison generale            *
  2008. *                                    *
  2009. *    entree : a7($4) pointe sur n2 de type I ou R        *
  2010. *         a7($8) pointe sur n1 de type I ou R        *
  2011. *    sortie : d0.l contient -1 si n2<n1,0 si n2=n1,1 sinon.    *
  2012. *         d1,a0,a1 sont sauvegardes                *
  2013. *    interdit : type S                        *
  2014. *                                    *
  2015. *===================================================================*
  2016.  
  2017. _mpcmp  link    a6,#0
  2018.     movem.l    d1-d2/a1-a2,-(sp)
  2019.     move.l    8(a6),a2
  2020.     move.l    12(a6),a1    ; a1 et a2 pointent sur n1 et n2
  2021.     moveq    #0,d1
  2022.     move.b    (a2),d2        ; d2.b contient T2
  2023.     cmp.b    (a1),d2
  2024.     ble.s     1$
  2025.                 ; ici T2 > T1
  2026.     exg     a1,a2
  2027.     moveq    #1,d1
  2028.                 ; ici T2 <= T1
  2029. 1$      move.l    a1,-(sp)
  2030.     move.l    a2,-(sp)
  2031.     cmp.b    #1,(a1)
  2032.     bne.s     2$
  2033.                 ; ici T1 = T2 = I
  2034.     bsr     _cmpii
  2035.     bra.s     cmpf
  2036.                 ; ici T1 = R
  2037. 2$      cmp.b    #1,(a2)
  2038.     bne.s     3$
  2039.                 ; ici T1 = R et T2 = I
  2040.     bsr     _cmpir
  2041.     bra.s     cmpf
  2042.                 ; ici T1 = T2 = R
  2043. 3$      bsr     _cmprr
  2044. cmpf     addq.l    #8,sp
  2045.     tst.b    d1
  2046.     beq.s     1$
  2047.     neg.l    d0
  2048. 1$      movem.l    (sp)+,d1-d2/a1-a2
  2049.     unlk    a6
  2050.     rts
  2051.  
  2052. *===================================================================*
  2053. *                                    *
  2054. *    Comparaison : entier court et entier court            *
  2055. *                                    *
  2056. *    entree : a7($4) contient s2 de type S            *
  2057. *         a7($8) contient s1 de type S            *
  2058. *    sortie : d0.l contient    -1 si s2<s1,0 si s2=s1,1 sinon    *
  2059. *         d1,a0,a1 sont sauvegardes                *
  2060. *                                    *
  2061. *===================================================================*
  2062.  
  2063. _cmpss  link    a6,#0
  2064.     movem.l    d1-d2,-(sp)
  2065.     move.l    8(a6),d2    ; d2.l contient s2
  2066.     move.l    12(a6),d1    ; d1.l contient s1
  2067.     cmp.l    d1,d2
  2068.     beq.s     1$
  2069.     bpl.s     2$
  2070.                 ; ici s2 < s1
  2071.     moveq    #-1,d0
  2072.     bra.s     cmpssf
  2073.                 ; ici s2 > s1
  2074. 2$      moveq    #1,d0
  2075.     bra.s     cmpssf
  2076.                 ; ici s2 = s1
  2077. 1$      moveq    #0,d0
  2078. cmpssf  movem.l    (sp)+,d1-d2
  2079.     unlk    a6
  2080.     rts
  2081.  
  2082. *===================================================================*
  2083. *                                    *
  2084. *        Comparaison : entier court et entier        *
  2085. *                                    *
  2086. *    entree : a7($4) contient s2 de type S            *
  2087. *         a7($8) pointe sur i1 de type I             *
  2088. *    sortie : d0.l contient 1 si s2>i1,0 si s2=i1,-1 sinon    *
  2089. *         d1,a0,a1 sont sauvegardes                *
  2090. *                                    *
  2091. *===================================================================*
  2092.  
  2093. _cmpsi  link    a6,#0
  2094.     movem.l    d1-d4/a1,-(sp)
  2095.     move.l    12(a6),a1    ; a1 pointe sur i1
  2096.     move.b    4(a1),d1    ; d1.b contient signe de i1 (si1)
  2097.     move.b    d1,d4        ; d4.b contient si1
  2098.     move.b    #1,d3
  2099.     move.l    8(a6),d2    ; d2.l contient s2
  2100.     bgt.s     1$        ; si s2 > 0
  2101.                 ; ici s2 <= 0
  2102.     bne.s     2$        ; si s2 < 0
  2103.                 ; ici s2 = 0
  2104.     move.b    #0,d3
  2105.     bra.s     1$
  2106.                 ; ici s2 < 0
  2107. 2$      move.b    #-1,d3        ; d3.b contient signe de s2 (ss2)
  2108. 1$      eor.b    d3,d4        ; d4.b contient :
  2109.                 ; 0 si les deux nuls ou >0 ou <0
  2110.                 ; >0 si un nul l'autre >0
  2111.                 ; <0 si un nul autre<0,un<0 autre>0     
  2112.     bpl.s     3$
  2113.                 ; ici d4.b < 0
  2114.     moveq    #1,d0
  2115.     tst.b    d3
  2116.     bpl.s     4$
  2117.                 ; ici s2<0 et i1>0
  2118.     moveq    #-1,d0
  2119. 4$      bra.s     cmpsif
  2120.                 ; ici d4.b >=0
  2121. 3$      cmp.w    #3,6(a1)
  2122.     ble.s     5$
  2123.                 ; ici L1 >= 2
  2124. 8$      moveq    #-1,d0
  2125.     tst.b    d1
  2126.     bpl.s     6$
  2127.     neg.l    d0
  2128. 6$      bra.s     cmpsif
  2129.                 ; ici L1 <= 1
  2130. 5$      cmp.w    #2,6(a1)
  2131.     beq.s     7$
  2132.                 ; ici L1 = 1
  2133.     tst.l    d2
  2134.     bpl.s     9$
  2135.     neg.l    d2
  2136. 9$      moveq    #1,d0
  2137.     cmp.l    8(a1),d2
  2138.     bhi.s     10$
  2139.     bne.s     11$
  2140.     moveq    #0,d0
  2141.     bra.s     cmpsif
  2142. 11$     moveq    #-1,d0
  2143. 10$     tst.b    d1
  2144.     bpl.s     cmpsif
  2145.     neg.l    d0
  2146.     bra.s     cmpsif
  2147. 7$      moveq    #1,d0
  2148.     tst.b    d3
  2149.     bne.s     cmpsif
  2150.     moveq    #0,d0
  2151. cmpsif  movem.l    (sp)+,d1-d4/a1
  2152.     unlk    a6
  2153.     rts
  2154.  
  2155. *===================================================================*
  2156. *                                    *
  2157. *        Comparaison : entier court et reel            *
  2158. *                                    *
  2159. *    entree : a7($4) contient s2 de type S            *
  2160. *         a7($8) pointe sur r1 de type R             *
  2161. *    sortie : d0.l contient 1 si s2>r1, 0 si s2=r1, -1 sinon     *
  2162. *         d1,a0,a1 sont sauvegardes                *
  2163. *                                    *
  2164. *===================================================================*
  2165.  
  2166. _cmpsr  link    a6,#0
  2167.     movem.l    d1-d4/a0-a2,-(sp)
  2168.     move.l    12(a6),a1    ; a1 pointe sur r1
  2169.     move.b    4(a1),d1    ; d1.b contient sr1 (signe de r1)
  2170.     move.b    d1,d4        ; d4.b aussi
  2171.     move.b    #1,d3
  2172.     move.l    8(a6),d2    ; d2.l contient s2
  2173.     bgt.s     1$
  2174.     bne.s     2$
  2175.     move.b    #0,d3
  2176.     bra.s     1$
  2177. 2$      move.b    #-1,d3        ; d3.b contient ss2 (signe de s2)
  2178. 1$      eor.b    d3,d4        ; d4.b contient 'signe'
  2179.     bpl.s     3$
  2180.                 ; ici d4.b < 0
  2181.     moveq    #1,d0
  2182.     tst.b    d3
  2183.     bpl.s     4$
  2184.     moveq    #-1,d0
  2185. 4$      bra.s     cmpsrf
  2186.                 ; ici d4.b >= 0
  2187. 3$      tst.b    d1
  2188.     bne.s     5$
  2189.                 ; ici r1 = 0
  2190.     moveq    #1,d0
  2191.     tst.b    d3
  2192.     bne.s     6$
  2193.                 ; ici s2 = r1 = 0
  2194.     moveq    #0,d0
  2195. 6$      bra.s     cmpsrf
  2196.                 ; ici r1 <> 0
  2197. 5$      move.w    2(a1),d0
  2198.     bsr     _getr        ; pour copie reelle de s2
  2199.     move.l    a0,a2    ; sauvegarde adresse copie
  2200.     move.l    a0,-(sp)     ; empilage adresse copie
  2201.     move.l    d2,-(sp)     ; empilage s2
  2202.     bsr     _affsr
  2203.     addq.l    #8,sp        ; depilage
  2204.     move.l    a1,-(sp)     ; empilage adresse r1
  2205.     move.l    a0,-(sp)     ; empilage adresse copie
  2206.     bsr     _cmprr
  2207.     addq.l    #8,sp
  2208.     move.l    a2,a0
  2209.     bsr     _giv
  2210. cmpsrf  movem.l    (sp)+,d1-d4/a0-a2
  2211.     unlk    a6
  2212.     rts
  2213.  
  2214. *===================================================================*
  2215. *                                    *
  2216. *        Comparaison : entier et entier court        *
  2217. *                                    *
  2218. *    entree : a7($4) pointe sur i2 de type I             *
  2219. *         a7($8) contient s1                 *
  2220. *    sortie : d0.l contient le signe de i2 - s1            *
  2221. *         aucun autre registre n'est affecte                 *
  2222. *                                    *
  2223. *===================================================================*
  2224.  
  2225. _cmpis  move.l    4(sp),-(sp)
  2226.     move.l    12(sp),-(sp)
  2227.     bsr     _cmpsi
  2228.     addq.l    #8,sp
  2229.     neg.l    d0
  2230.     rts
  2231.  
  2232. *===================================================================*
  2233. *                                    *
  2234. *        Comparaison : entier et entier            *
  2235. *                                    *
  2236. *    entree : a7($4) pointe sur i2 de type I             *
  2237. *         a7($8) pointe sur i1 de type I             *
  2238. *    sortie : d0.l contient :1 si i2>i1,0 si i2=i1,-1 sinon    *
  2239. *         d1,a0,a1 sont sauvegardes                *
  2240. *                                    *
  2241. *===================================================================*
  2242.  
  2243. _cmpii  link    a6,#0
  2244.     movem.l    d1-d4/a1-a2,-(sp)
  2245.     move.l    8(a6),a2
  2246.     move.l    12(a6),a1    ; a1, a2 pointent sur i1, i2
  2247.     move.b    4(a1),d1    ; d1.b contient si1
  2248.     move.b    d1,d4
  2249.     move.b    4(a2),d2    ; d2.b contient si2
  2250.     eor.b    d2,d4
  2251.     bpl.s     1$
  2252.                 ; ici d4.b < 0
  2253.     moveq    #1,d0
  2254.     tst.b    d2
  2255.     bpl.s     cmpiif
  2256.     moveq    #-1,d0
  2257.     bra.s     cmpiif
  2258.                 ; ici d4.b >= 0
  2259. 1$      move.w    6(a1),d1
  2260.     move.w    6(a2),d2    ; d1.w et d2.w contiennent le1 et le2
  2261.     cmp.w    d1,d2
  2262.     blt.s     3$
  2263.     beq.s     4$
  2264.                 ; ici le2 > le1
  2265. 6$      moveq    #1,d0
  2266.     tst.b    4(a1)
  2267.     bpl.s     cmpiif
  2268.     moveq    #-1,d0
  2269.     bra.s     cmpiif
  2270.                 ; ici le2 < le1
  2271. 3$      moveq    #-1,d0
  2272.     tst.b    4(a2)
  2273.     bpl.s     cmpiif
  2274.     moveq    #1,d0
  2275.     bra.s     cmpiif
  2276.                 ; ici le2 = le1
  2277. 4$      cmp.w    #2,d1
  2278.     bne.s     7$
  2279.     moveq    #0,d0
  2280.     bra.s     cmpiif
  2281.                 ; ici i1 et i2 <> 0
  2282. 7$      move.b    4(a1),d3
  2283.     addq.l    #8,a1
  2284.     addq.l    #8,a2
  2285.     subq.w    #3,d1
  2286. 11$     cmpm.l    (a1)+,(a2)+
  2287.     dbne    d1,11$
  2288.     bhi.s     8$
  2289.     beq.s     9$
  2290.     moveq    #-1,d0
  2291.     bra.s     10$
  2292. 9$      moveq    #0,d0
  2293.     bra.s     cmpiif
  2294. 8$      moveq    #1,d0
  2295. 10$     tst.b    d3
  2296.     bpl.s     cmpiif
  2297.     neg.l    d0
  2298. cmpiif  movem.l    (sp)+,d1-d4/a1-a2
  2299.     unlk    a6
  2300.     rts
  2301.  
  2302. *===================================================================*
  2303. *                                    *
  2304. *        Comparaison : entier et reel            *
  2305. *                                    *
  2306. *    entree : a7($4) pointe sur i2 de type R             *
  2307. *         a7($8) pointe sur r1 de type R             *
  2308. *    sortie : d0.l contient :1 si i2>r1,0 si i2=r1,-1 sinon    *
  2309. *         d1,a0,a1 sont sauvegardes                *
  2310. *                                    *
  2311. *===================================================================*
  2312.  
  2313. _cmpir  link    a6,#0
  2314.     movem.l    d1-d4/a0-a3,-(sp)
  2315.     move.l    8(a6),a2
  2316.     move.l    12(a6),a1    ; a1 et a2 pointent sur r1 et i2
  2317.     move.b    4(a1),d1
  2318.     move.b    d1,d4
  2319.     move.b    4(a2),d2
  2320.     eor.b    d2,d4
  2321.     bpl.s     1$
  2322.     moveq    #1,d0
  2323.     tst.b    d2
  2324.     bpl.s     2$
  2325.     moveq    #-1,d0
  2326. 2$      bra.s     cmpirf
  2327.                 ; ici d4.b >= 0
  2328. 1$      tst.b    d1
  2329.     bne.s     3$
  2330.     moveq    #1,d0
  2331.     tst.b    d2
  2332.     bne.s     4$
  2333.     moveq    #0,d0
  2334. 4$      bra.s     cmpirf
  2335.                 ; ici faire copie de i2 en type R
  2336. 3$      move.w    2(a1),d0    ; allouer memoire pour copie de i2
  2337.     bsr     _getr
  2338.     move.l    a0,a3
  2339.     move.l    a0,-(sp)     ; empiler adresse copie
  2340.     move.l    a2,-(sp)     ; empiler adresse i2
  2341.     bsr     _affir
  2342.     addq.l    #8,sp        ; depiler
  2343.     move.l    a1,-(sp)     ; empiler adresse r1
  2344.     move.l    a0,-(sp)     ; empiler adresse copie
  2345.     bsr.s     _cmprr
  2346.     addq.l    #8,sp        ; depiler
  2347.     move.l    a3,a0
  2348.     bsr     _giv         ; rendre copie
  2349. cmpirf  movem.l    (sp)+,d1-d4/a0-a3
  2350.     unlk    a6
  2351.     rts
  2352.  
  2353. *===================================================================*
  2354. *                                    *
  2355. *        Comparaison : reel et entier court            *
  2356. *                                    *
  2357. *    entree : a7($4) pointe sur r2 de type R             *
  2358. *         a7($8) contient s1                 *
  2359. *    sortie : d0.l contient le signe de r2 - s1            *
  2360. *         aucun autre registre n'est affecte                 *
  2361. *                                    *
  2362. *===================================================================*
  2363.  
  2364. _cmprs  move.l    4(sp),-(sp)
  2365.     move.l    12(sp),-(sp)
  2366.     bsr     _cmpsr
  2367.     addq.l    #8,sp
  2368.     neg.l    d0
  2369.     rts
  2370.  
  2371. *===================================================================*
  2372. *                                    *
  2373. *        Comparaison : reel et entier            *
  2374. *                                    *
  2375. *    entree : a7($4) pointe sur r2 de type R             *
  2376. *         a7($8) contient i1                 *
  2377. *    sortie : d0.l contient le signe de r2 - i1            *
  2378. *         aucun autre registre n'est affecte                 *
  2379. *                                    *
  2380. *===================================================================*
  2381.  
  2382. _cmpri  move.l    4(sp),-(sp)
  2383.     move.l    12(sp),-(sp)
  2384.     bsr.s     _cmpir
  2385.     addq.l    #8,sp
  2386.     neg.l    d0
  2387.     rts
  2388.  
  2389. *===================================================================*
  2390. *                                    *
  2391. *        Comparaison : reel et reel                *
  2392. *                                    *
  2393. *    entree : a7($4) pointe sur r2 de type R             *
  2394. *         a7($8) pointe sur r1 de type R             *
  2395. *    sortie : d0.l contient :1 si r2>r1,0 si r2=r1,-1 sinon    *
  2396. *         d1,a0,a1 sont sauvegardes                *
  2397. *                                    *
  2398. *===================================================================*
  2399.  
  2400. _cmprr  link    a6,#0
  2401.     movem.l    d1-d5/a1-a2,-(sp)
  2402.     move.l    8(a6),a2
  2403.     move.l    12(a6),a1    ; a1 et a2 pointent sur r1 et r2
  2404.     move.b    4(a1),d1
  2405.     move.b    d1,d4
  2406.     move.b    4(a2),d2
  2407.     eor.b    d2,d4
  2408.     bpl.s     1$
  2409.                 ; ici d4.b < 0
  2410.     moveq    #1,d0
  2411.     tst.b    d2
  2412.     bpl.s     2$
  2413.     moveq    #-1,d0
  2414. 2$      bra.s     cmprrf
  2415.                 ; ici d4.b >= 0
  2416. 1$      tst.b    d1
  2417.     bne.s     3$
  2418.     moveq    #1,d0
  2419.     tst.b    d2
  2420.     bne.s     4$
  2421.     moveq    #0,d0
  2422. 4$      bra.s     cmprrf
  2423. 3$      tst.b    4(a2)
  2424.     bne.s     5$
  2425.     moveq    #-1,d0
  2426.     bra.s     cmprrf
  2427.                 ; ici r2 <> 0
  2428. 5$      moveq    #1,d0
  2429.     move.w    2(a1),d1
  2430.     move.w    2(a2),d2
  2431.     cmp.w    d1,d2
  2432.     bpl.s     6$
  2433.     exg     d1,d2
  2434.     exg     a1,a2
  2435.     moveq    #-1,d0
  2436. 6$      tst.b    4(a2)
  2437.     bpl.s     7$
  2438.     neg.l    d0
  2439. 7$      move.l    4(a1),d5
  2440.     and.l    #$ffffff,d5
  2441.     move.l    4(a2),d3
  2442.     and.l    #$ffffff,d3
  2443.     cmp.l    d5,d3
  2444.     bpl.s     8$
  2445. 10$     neg.l    d0
  2446.     bra.s     cmprrf
  2447. 8$      bne.s     cmprrf
  2448.     sub.w    d1,d2
  2449.     subq.w    #3,d1
  2450.     addq.l    #8,a1
  2451.     addq.l    #8,a2
  2452. 9$      cmpm.l    (a1)+,(a2)+
  2453.     dbne    d1,9$
  2454.     bcs.s     10$
  2455.     beq.s     11$
  2456.     bra.s     cmprrf
  2457. 12$     tst.l    (a2)+
  2458. 11$     dbne    d2,12$
  2459.     bne.s     cmprrf
  2460.     moveq    #0,d0
  2461. cmprrf  movem.l    (sp)+,d1-d5/a1-a2
  2462.     unlk    a6
  2463.     rts
  2464.  
  2465.  
  2466.  
  2467.  
  2468.  
  2469. *********************************************************************
  2470. *********************************************************************
  2471. ***                                   ***
  2472. ***             PROGRAMMES D'ADDITION                     ***
  2473. ***                                   ***
  2474. *********************************************************************
  2475. *********************************************************************
  2476.  
  2477.  
  2478.  
  2479.  
  2480.  
  2481. *===================================================================*
  2482. *                                    *
  2483. *            Addition generale                *
  2484. *                                    *
  2485. *    entree : a7($4) pointe sur n2 de type I ou R        *
  2486. *         a7($8) pointe sur n1 de type I ou R        *
  2487. *    sortie : d0 pointe sur n2 + n1 de type I ou R (zone creee)    *
  2488. *    interdit : type S                        *
  2489. *    precision : voir les formules des routines specalisees    *
  2490. *                                    *
  2491. *===================================================================*
  2492.  
  2493. _mpadd  move.l    4(sp),a0
  2494.     move.l    8(sp),a1    ; a1 et a0 pointent sur n1 et n2
  2495.     move.b    (a0),d0
  2496.     move.b    (a1),d1        ; d1.b et d0.b contiennent T1 et T2
  2497.     cmp.b    d1,d0
  2498.     ble.s     1$
  2499.                 ; ici T2 > T1
  2500.     exg     a1,a0
  2501.     exg     d1,d0
  2502.     move.l    a0,4(sp)
  2503.     move.l    a1,8(sp)
  2504.                 ; ici T2 <= T1
  2505. 1$      cmp.b    #1,d1
  2506.     beq     _addii        ; ici T1 = T2 = I
  2507. 2$      cmp.b    #2,d0
  2508.     beq     _addrr        ; ici T1 = T2 = R
  2509.     bra     _addir
  2510.  
  2511. *===================================================================*
  2512. *                                    *
  2513. *            Addition (par valeur)            *
  2514. *                                    *
  2515. *    entree : a7($4) pointe sur n2 de type I ou R        *
  2516. *         a7($8) pointe sur n1 de type I ou R        *
  2517. *         a7($12) pointe sur n3 de type I ou R        *
  2518. *    sortie : la zone pointee par a7($12) contient n2+n1     *
  2519. *    interdit : type S                        *
  2520. *                                    *
  2521. *===================================================================*
  2522.  
  2523. _mpaddz lea     _mpadd,a0
  2524.     bra     mpopz
  2525.  
  2526.                 ; addition S+S=I ou R
  2527.  
  2528. _addssz lea     _addss,a0
  2529.     bra     mpopz
  2530.  
  2531.                 ; addition S+I=I ou R
  2532.  
  2533. _addsiz lea     _addsi,a0
  2534.     bra     mpopz
  2535.  
  2536.                 ; addition S+R=R sinon erreur
  2537.  
  2538. _addsrz lea     _addsr,a0
  2539.     bra     mpopz
  2540.  
  2541.                 ; addition I+I=I ou R
  2542.  
  2543. _addiiz lea     _addii,a0
  2544.     bra     mpopz
  2545.  
  2546.                 ; addition I+R=R sinon erreur
  2547.  
  2548. _addirz lea     _addir,a0
  2549.     bra     mpopz
  2550.  
  2551.                 ; addition R+R=R sinon erreur
  2552.  
  2553. _addrrz lea     _addrr,a0
  2554.     bra     mpopz
  2555.  
  2556. *===================================================================*
  2557. *                                    *
  2558. *     Addition : entier court + entier court = entier        *
  2559. *                                    *
  2560. *    entree : a7($4) contient s2 de type S            *
  2561. *         a7($8) contient s1 de type S            *
  2562. *    sortie : d0 pointe sur s1+s2 de type I(zone cree)        *
  2563. *    remarque : s1 + s2 = s0 est interdit            *
  2564. *                                    *
  2565. *===================================================================*
  2566.  
  2567. _addss  link    a6,#-2
  2568.     move.l    d2,-(sp)
  2569.     move.l    8(a6),d1
  2570.     move.l    12(a6),d2
  2571.     add.l    d2,d1        ; d1.l contient s2 + s1
  2572.     bne.s     1$
  2573.                 ; ici d1.l=0
  2574.     bvs.s     2$
  2575.                 ; ici s1+s2=0
  2576.     move.w    #2,d0
  2577.     bsr     _geti
  2578.     move.l    #2,4(a0)
  2579.     bra.s     addssf
  2580.                 ; ici s1+s2=-2^32 (s1=s2=-2^31)
  2581. 2$      move.w    #4,d0
  2582.     bsr     _geti
  2583.     move.l    #$ff000004,4(a0)
  2584.     move.l    #1,8(a0)
  2585.     clr.l    12(a0)
  2586.     bra.s     addssf
  2587.                 ; ici d1.l<>0
  2588. 1$      move.w    #3,d0
  2589.     bsr     _geti
  2590.     move.l    #$1000003,4(a0)
  2591.     add.l    8(a6),d2    ; repositionne les indicateurs
  2592.     bvs.s     3$
  2593.                 ; ici pas d'overflow
  2594.     bmi.s     4$        ; d1 donne bien le signe du resultat
  2595.     bra.s     5$
  2596.                 ; ici overflow
  2597. 3$      bcc.s     5$        ; le carry donne le signe du resultat
  2598. 4$      neg.l    d1
  2599.     move.b    #$ff,4(a0)
  2600. 5$      move.l    d1,8(a0)
  2601. addssf  move.l    a0,d0        ; d0 pointe sur resultat
  2602.     move.l    (sp),d2
  2603.     unlk    a6
  2604.     rts
  2605.  
  2606. *===================================================================*
  2607. *                                    *
  2608. *        Addition : entier court + entier = entier        *
  2609. *                                    *
  2610. *    entree : a7($4) contient s2 de type S            *
  2611. *         a7($8) pointe sur i1 de type I             *
  2612. *    sortie : d0 pointe sur s2 + i1 de type I (zone creee)    *
  2613. *                                    *
  2614. *===================================================================*
  2615.  
  2616. _addsi  link    a6,#0
  2617.     movem.l    d2-d4/a2,-(sp)
  2618.     move.l    12(a6),a1    ; a1 pointe sur i1
  2619.     move.l    8(a6),d2    ; d2.l contient s2
  2620.     bne.s     1$        ; si s2 <> 0
  2621.                 ; ici s2 = 0 (i1 + s2 = i1)
  2622.     move.w    6(a1),d0
  2623.     bsr     _geti        ; allocation memoire pour resultat
  2624.     move.l    a0,d4
  2625.     subq.w    #2,d0        ; compteur de boucle pour recopie de i1
  2626.     addq.l    #4,a0
  2627.     addq.l    #4,a1
  2628. 2$      move.l    (a1)+,(a0)+    ; recopie de i1
  2629.     dbra    d0,2$
  2630.     bra     addsif
  2631.                 ; ici s2 <> 0
  2632. 1$      tst.b    4(a1)
  2633.     bne.s     3$        ; si i1 <> 0
  2634.                 ; ici i1 = 0 (i1 + s2 = s2)
  2635.     moveq    #3,d0
  2636.     bsr     _geti        ; allocation memoire pour resultat
  2637.     move.l    a0,d4
  2638.     move.l    #$1000003,4(a0)
  2639.     move.l    d2,8(a0)
  2640.     
  2641.     bpl     addsif
  2642.                 ; ici s2 < 0
  2643.     move.b    #$ff,4(a0)
  2644.     neg.l    8(a0)
  2645.     bra.s     addsif
  2646.                 ; ici s2 et i1 <> 0
  2647. 3$      move.w    6(a1),d0    ; d0.w contient le1
  2648.     bsr     _geti
  2649.     move.l    a0,d4
  2650.     move.w    4(a1),d1
  2651.     ext.l    d1        ; d1.l contient signe de i1
  2652.     lea     0(a0,d0.w*4),a0
  2653.     lea     0(a1,d0.w*4),a2 ; a0 pointe fin du resultat;a2 fin de i1
  2654.     moveq    #0,d3
  2655.     subq.w    #3,d0        ; d0.w compteur boucle addition
  2656.     eor.l    d2,d1        ; comparaison signes i1 et s2
  2657.     bmi.s     susi        ; si i1 * s2 < 0
  2658.                 ; ici i1 * s2 > 0
  2659.     tst.l    d2
  2660.     bpl.s     51$         ; valeur absolue de s2
  2661.     neg.l    d2
  2662. 51$     add.l    -(a2),d2
  2663.     bra.s     4$        ; boucle d'addition
  2664. 5$      move.l    d2,-(a0)
  2665.     move.l    -(a2),d2
  2666.     addx.l    d3,d2
  2667. 4$      dbra    d0,5$
  2668.     bcc.s     6$        ; ici retenue finale
  2669.     move.l    d2,-(a0)     ; mise a jour dernier long mot
  2670.     moveq    #1,d0
  2671.     bsr     _geti        ; allocation un long mot supplementaire
  2672.     move.l    a0,d4
  2673.     move.l    4(a0),(a0)
  2674.     addq.w    #1,2(a0)    ; mise a jour premier long mot code
  2675.     cmp.w    #$7fff,2(a0)
  2676.     bls.s     7$
  2677.                 ; ici debordement
  2678.     move.l    #adder1,-(sp)
  2679.     jsr     _err
  2680. 7$      move.w    2(a0),6(a0)    ; mise longueur effective
  2681.     move.l    #1,8(a0)    ; mise a jour retenue finale
  2682.     bra.s     8$
  2683.                 ; ici pas de retenue finale
  2684. 6$      move.l    d2,-(a0)     ; mise a jour dernier long mot
  2685.     subq.w    #8,a0
  2686.     move.w    2(a0),6(a0)    ; longueur effective
  2687. 8$      move.w    4(a1),4(a0)    ; signe du resultat
  2688.     move.l    a0,d4
  2689. addsif  move.l    d4,d0        ; d0 pointe sur resultat
  2690.     movem.l    (sp)+,d2-d4/a2
  2691.     unlk    a6
  2692.     rts
  2693.                 ; ici i1 * s2 < 0 : soustraction
  2694. susi     move.l    d2,d1        ; d1.l recoit s2
  2695.     bpl.s     6$
  2696.     neg.l    d1        ; d1.l recoit |s2|
  2697. 6$      move.l    -(a2),d2
  2698.     sub.l    d1,d2        ; amorcage de la soustraction
  2699.     bra.s     1$
  2700.                 ; boucle de soustraction
  2701. 2$      move.l    d2,-(a0)
  2702.     move.l    -(a2),d2
  2703.     subx.l    d3,d2
  2704. 1$      dbra    d0,2$
  2705.     bcc.s     3$
  2706.                 ; ici retenue finale:longueur resultat=3
  2707.     neg.l    d2
  2708.     move.l    d2,-(a0)
  2709.     subq.l    #8,a0        ; a0 pointe sur resultat
  2710.     move.w    #3,6(a0)    ; mise a jour longueur effective
  2711.     move.b    4(a1),d2
  2712.     neg.b    d2
  2713.     move.b    d2,4(a0)    ; mise a jour signe (-|i1|)
  2714.     bra.s     addsif
  2715.                 ; ici pas de retenue finale
  2716. 3$      tst.l    d2
  2717.     beq.s     4$
  2718.                 ; ici d2 <> 0
  2719.     move.l    d2,-(a0)
  2720.     move.l    4(a1),-(a0)     ; mise a jour second long mot code
  2721.     bra.s     addsif
  2722.                 ; ici d2 = 0
  2723. 4$      move.l    4(a1),-(a0)
  2724.     subq.w    #1,2(a0)
  2725.     cmp.w    #2,2(a0)
  2726.     bne.s     5$
  2727.                 ; ici L1 = 1 ; le resultat est 0
  2728.     clr.b    (a0)
  2729. 5$      move.l    -8(a0),-(a0)
  2730.     subq.w    #1,2(a0)
  2731.     move.l    a0,d4
  2732.     addq.l    #4,_avma        ; mise a jour pile PARI
  2733.     bra.s     addsif
  2734.  
  2735. *===================================================================*
  2736. *                                    *
  2737. *        Addition : entier + entier = entier         *
  2738. *                                    *
  2739. *    entree : a7($4) pointe sur i2 de type I             *
  2740. *         a7($8) pointe sur i1 de type I             *
  2741. *    sortie : d0 pointe sur i2 + i1 de type I (zone creee)    *
  2742. *                                    *
  2743. *===================================================================*
  2744.  
  2745. _addii  link    a6,#0
  2746.     movem.l    d2-d7/a2-a4,-(sp)
  2747.     move.l    8(a6),a2    ; a2 pointe sur i2
  2748.     move.l    12(a6),a1    ; a1 pointe sur i1
  2749.     moveq    #0,d2
  2750.     moveq    #0,d1
  2751.     move.w    6(a2),d2
  2752.     move.w    6(a1),d1    ; d1.w recoit le1 et d2.w recoit le2
  2753.     cmp.w    d1,d2
  2754.     bcc.s     1$
  2755.     exg     a1,a2
  2756.     exg     d1,d2        ; si L2 < L1 ,echanger a1,a2 et d1,d2
  2757.                 ; ici L2 >= L1
  2758. 1$      tst.b    4(a1)
  2759.     bne.s     2$        ; ici i1 = 0 : i1 + i2 = i2
  2760.     move.w    6(a2),d0
  2761.     bsr     _geti        ; allocation memoire pour recopie de i2
  2762.     subq.w    #2,d0        ; compteur de recopie
  2763.     move.l    a0,a1
  2764.     addq.l    #4,a1
  2765.     addq.l    #4,a2
  2766.                 ; boucle de recopie
  2767. 3$      move.l    (a2)+,(a1)+
  2768.     dbra    d0,3$
  2769.     bra     addiif
  2770.                 ; ici i1 <> 0 ( donc i2 <> 0)
  2771. 2$      move.b    4(a1),d3
  2772.     move.b    4(a2),d4
  2773.     eor.b    d4,d3        ; d3 contient signe de i2 * i1
  2774.     bmi     suii
  2775.                 ; ici i2 * i1 > 0
  2776.     move.w    d2,d0
  2777.     bsr     _geti        ; allocation memoire le2 longs mots
  2778.     lea     0(a0,d0.w*4),a0 ; a0 pointe fin du resultat
  2779.     lea     0(a2,d0.w*4),a2 ; a2 pointe fin de i2
  2780.     lea     0(a1,d1.w*4),a1 ; a1 pointe fin de i1
  2781.     sub.w    d1,d2        ; d2.w contient L2-L1
  2782.     subq.w    #3,d1        ; d1.w contient L1-1 (compteur)
  2783.     moveq    #0,d4
  2784.                 ; ici premiere boucle d'addition
  2785. 4$      move.l    -(a1),d0
  2786.     move.l    -(a2),d5
  2787.     addx.l    d5,d0
  2788.     move.l    d0,-(a0)
  2789.     dbra    d1,4$
  2790.     roxr.w    d4,d0        ; mise a jour dernier long mot
  2791.     bra.s     5$
  2792.                 ; ici deuxieme boucle:propagation carry
  2793. 6$      move.l    -(a2),d0
  2794.     addx.l    d4,d0
  2795.     move.l    d0,-(a0)
  2796.     roxr.w    d4,d0
  2797. 5$      dbcc    d2,6$
  2798.     bcs.s     7$        ; si carry jusqu'a la fin
  2799.                 ; ici pas de carry
  2800.     bra.s     8$
  2801.                 ; ici troisieme boucle:recopie mantisse
  2802. 9$      move.l    -(a2),-(a0)
  2803. 8$      dbra    d2,9$
  2804.                 ; ici pas de carry finale
  2805.     move.l    -(a2),-(a0)
  2806.     subq.l    #4,a0
  2807.     bra.s     addiif
  2808.                 ; ici carry finale
  2809. 7$      move.w    -2(a2),d2
  2810.     addq.w    #1,d2
  2811.     cmp.w    #$8000,d2
  2812.     bcs.s     10$
  2813.                 ; ici debordement
  2814.     move.l    #adder2,-(sp)
  2815.     jsr     _err
  2816.                 ; ici demander 1 long mot en plus
  2817. 10$     moveq    #1,d0
  2818.     bsr     _geti
  2819.     move.l    #1,8(a0)    ; mise retenue
  2820.     move.l    4(a0),(a0)
  2821.     move.w    d2,2(a0)    ; mise a jour premier long mot code
  2822.     move.l    -(a2),4(a0)
  2823.     move.w    d2,6(a0)    ; idem deuxieme long mot code
  2824. addiif  move.l    a0,d0        ; d0 pointe sur resultat
  2825.     movem.l    (sp)+,d2-d7/a2-a4
  2826.     unlk    a6
  2827.     rts
  2828.                 ; ici i2 * i1 < 0 : soustraction
  2829. suii     move.l    a1,a3
  2830.     move.l    a2,a4        ; a3,a4 pointent sur i1,i2
  2831.     sub.w    d1,d2        ; d2.w contient L2-L1
  2832.     bne.s     1$
  2833.                 ; ici L2=L1
  2834.     subq.w    #3,d1        ; d1.w    contient L1-1
  2835.     addq.l    #8,a3
  2836.     addq.l    #8,a4        ; a3,a4 pointent debut mantisses i1,i2
  2837. 2$      cmpm.l    (a3)+,(a4)+
  2838.     dbne    d1,2$        ; on compare |i1| et |i2|
  2839.     bhi.s     1$        ; si |i2| > |i1|
  2840.                 ; ici |i2| < |i1|
  2841.     bne.s     3$
  2842.                 ; ici |i2| = |i1| : i2 + i1 = 0
  2843.     move.w    #2,d0
  2844.     bsr     _geti
  2845.     move.l    #2,4(a0)
  2846.     bra.s     addiif
  2847.                 ; ici |i2| < |i1| : echanger i2 et i1
  2848. 3$      exg     a1,a2
  2849.                 ; ici |i2| > |i1| (signe i2=signe resultat)
  2850. 1$      move.w    6(a2),d0
  2851.     bsr     _geti        ; allocation memoire le2 longs mots
  2852.     move.w    6(a1),d1    ; d1.w    contient L1+2
  2853.     move.l    a0,-(sp)     ; empilage adresse resultat
  2854.     move.b    4(a2),d7    ; d7.b    contient signe resultat
  2855.     lea     0(a1,d1.w*4),a1
  2856.     lea     0(a2,d0.w*4),a2
  2857.     lea     0(a0,d0.w*4),a0 ; a0,a1,a2 pointent fin resultat,i1,i2
  2858.     sub.l    d3,d3        ; initialisation bit X
  2859.     subq.w    #3,d1        ; d1.w contient L1-1 (compteur)
  2860.                 ; premiere boucle de soustraction
  2861. 4$      move.l    -(a2),d0
  2862.     move.l    -(a1),d5
  2863.     subx.l    d5,d0
  2864.     move.l    d0,-(a0)
  2865.     dbra    d1,4$
  2866.     roxr.w    d3,d0        ; restauration du bit C
  2867.     bra.s     5$
  2868.                 ; deuxieme boucle:propagation carry
  2869. 6$      move.l    -(a2),d5
  2870.     subx.l    d3,d5
  2871.     move.l    d5,-(a0)
  2872.     roxr.w    d3,d0
  2873. 5$      dbcc    d2,6$
  2874.     bra.s     7$
  2875.                 ; troisieme boucle:recopie fin i2
  2876. 8$      move.l    -(a2),-(a0)
  2877. 7$      dbra    d2,8$
  2878.     move.l    (sp)+,a0     ; depilage adresse resultat
  2879.     move.w    2(a0),d1    ; d1.w contient lon eff du resultat
  2880.     moveq    #0,d2
  2881.     move.w    d1,d2        ; d2.w idem
  2882.     addq.l    #8,a0        ; a0 pointe mantisse resultat
  2883. 9$      tst.l    (a0)+
  2884.     dbne    d1,9$        ; chasse aux '0' partie gauche resultat
  2885.     subq.l    #4,a0        ; a0 pointe 1er long mot non nul
  2886.     move.l    d1,-(a0)     ; mise a jour longueur effective
  2887.     move.b    d7,(a0)        ; mise a jour signe
  2888.     move.w    d1,-(a0)     ; mise a jour longueur totale
  2889.     move.w    #$101,-(a0)     ; mise a jour type et peres
  2890.     sub.w    d1,d2
  2891.     lsl.l    #2,d2
  2892.     add.l    d2,_avma        ; mise a jour pile PARI
  2893.     bra     addiif
  2894.  
  2895. *===================================================================*
  2896. *                                    *
  2897. *        Addition : entier court + reel = reel        *
  2898. *                                    *
  2899. *    entree : a7($4) contient s2 de type S            *
  2900. *         a7($8) pointe sur r1 de type R             *
  2901. *    sortie : d0 pointe sur s2 + r1 de type R (zone creee)    *
  2902. *                                    *
  2903. *===================================================================*
  2904.  
  2905. _addsr  link    a6,#-12     ; 3 lgmots pour transformer s2 en type I
  2906.     move.l    8(a6),d1    ; d1.l contient s2
  2907.     bne.s     1$
  2908.                 ; ici s2 = 0
  2909.     move.l    #$1000002,-12(a6)
  2910.     move.l    #2,-8(a6)
  2911.     bra.s     3$
  2912.                 ; ici s2 <> 0
  2913. 1$      bmi.s     2$
  2914.     move.l    #$1000003,-12(a6)
  2915.     move.l    #$1000003,-8(a6)
  2916.     move.l    d1,-4(a6)
  2917.     bra.s     3$
  2918.                 ; ici s2 < 0
  2919. 2$      move.l    #$1000003,-12(a6)
  2920.     move.l    #$ff000003,-8(a6)
  2921.     neg.l    d1
  2922.     move.l    d1,-4(a6)
  2923. 3$      move.l    12(a6),-(sp)
  2924.     pea     -12(a6)
  2925.     bsr.s     _addir
  2926.     unlk    a6
  2927.     rts     
  2928.     
  2929. *===================================================================*
  2930. *                                    *
  2931. *        Addition : entier + reel = reel             *
  2932. *                                    *
  2933. *    entree : a7($4) pointe sur i2 de type I             *
  2934. *         a7($8) pointe sur r1 de type R             *
  2935. *    sortie : d0 pointe sur i2 + r1 de type R (zone creee)    *
  2936. *    precision : si exp2>=exp1 , L = L1 + int((exp2-exp1)/32) + 1*
  2937. *            si exp2<exp1  , L = L1                *
  2938. *            i2 est transforme en un reel            *
  2939. *                                    *
  2940. *===================================================================*
  2941.  
  2942. _addir  link    a6,#-4        ; var. locale pour copie i2 en r2
  2943.     movem.l    d2-d3/a2,-(sp)
  2944.     move.l    8(a6),a2
  2945.     move.l    12(a6),a1    ; a1,a2 pointent sur r1,i2
  2946.     tst.b    4(a2)
  2947.     bne.s     1$
  2948.                 ; ici i2 = 0 ( i2 + r1 = r1)
  2949. 6$      move.w    2(a1),d0
  2950.     bsr     _getr
  2951.     move.l    a0,-4(a6)    ; sauve adresse resultat
  2952.     addq.l    #4,a1
  2953.     addq.l    #4,a0
  2954.     subq.w    #2,d0
  2955.                 ; boucle de copie d'un reel
  2956. 4$      move.l    (a1)+,(a0)+
  2957.     dbra    d0,4$
  2958.     bra     addirf
  2959.                 ; ici i2 <> 0
  2960. 1$      tst.b    4(a1)
  2961.     bne.s     3$
  2962.                 ; ici r1 = 0 (i2 + r1 = i2)
  2963.     move.l    4(a1),d1
  2964.     sub.l    #$800000,d1
  2965.     asr.l    #5,d1
  2966.     moveq    #0,d0
  2967.     move.w    6(a2),d0
  2968.     sub.l    d1,d0        ; d0.l contient L2-[exp1/32]
  2969.     cmp.l    #3,d0
  2970.     bcs     2$
  2971.     cmp.l    #$8000,d0
  2972.     bcc     2$
  2973.     bsr     _getr
  2974.     move.l    a0,-4(a6)
  2975.     move.l    a0,-(sp)
  2976.     move.l    a2,-(sp)
  2977.     bsr     _affir        ; le resultat est i2 en type R
  2978.     addq.l    #8,sp        ; de longueur L2-[exp1/32]
  2979.     bra     addirf
  2980.                 ; ici i2 et r1 <> 0
  2981. 3$      move.l    8(a2),d0
  2982.     bfffo    d0{0:32},d1    ; d1.l recoit nb de shifts (=s)
  2983.     moveq    #0,d0
  2984.     move.w    6(a2),d0
  2985.     subq.w    #2,d0
  2986.     lsl.l    #5,d0
  2987.     sub.l    d1,d0
  2988.     subq.l    #1,d0        ; d0.l recoit 32*L2-s-1 = exp2
  2989.     moveq    #0,d3
  2990.     move.w    2(a1),d3    ; d3.w recoit l1
  2991.     move.l    4(a1),d2
  2992.     and.l    #$ffffff,d2
  2993.     sub.l    #$800000,d2    ; d2.l recoit exp1
  2994.     sub.l    d0,d2        ; d2.l recoit exp1-exp2
  2995.     ble.s     5$
  2996.                 ; ici exp1 > exp2
  2997.     lsr.l    #5,d2        ; d2.l recoit L3=[(exp1-exp2)/32]
  2998.     sub.l    d2,d3        ; d3.l recoit L1-L3+2
  2999.     cmp.l    #2,d3
  3000.     ble     6$        ; si L1 <= L3 alors:r1+i2=r1
  3001.                 ; ici L1 > L3
  3002. 7$      move.l    _avma,-(sp)    ; empilage pile PARI
  3003.     move.w    d3,d0
  3004.     bsr     _getr        ; allocation memoire L1-L3+2 lg mots
  3005.                 ; pour ecrire i2 en type R
  3006.     move.l    a0,-(sp)     ; empilage r2 (copie de i2)
  3007.     move.l    a2,-(sp)     ; empilage i2
  3008.     bsr     _affir
  3009.     move.l    a1,(sp)        ; empilage r1
  3010.     bsr.s     _addrr
  3011.     move.l    d0,a0        ; a0 pointe sur r2 + r1
  3012.     move.w    2(a0),d0    ; d0.w contient lr (longueur resultat)
  3013.     subq.w    #1,d0        ; d0.w contient lr-1 (compteur pile)
  3014.     move.l    4(sp),a1    ; a1 pointe sur r2
  3015.     addq.l    #8,sp        ; depilage r1 et r2
  3016.     moveq    #0,d1
  3017.     move.w    2(a1),d1
  3018.     lsl.l    #2,d1        ; d1.l contient 4*l2 (nb d'octets a 
  3019.                 ; desallouer dans pile PARI)
  3020.  
  3021.     move.l    (sp)+,a0     ; a0 pointe sur ancien __avma
  3022.                 ; boucle de transfert du resultat
  3023. 8$      move.l    -(a1),-(a0)
  3024.     dbra    d0,8$
  3025.     add.l    d1,_avma    ; mise a jour pile PARI
  3026.     move.l    a0,-4(a6)
  3027.     bra.s     addirf
  3028.                 ; ici exp1 <= exp2
  3029. 5$      neg.l    d2
  3030.     lsr.l    #5,d2        ; d2.l recoit L3=[(exp2-exp1)/32]
  3031.     add.w    d2,d3
  3032.     addq.w    #1,d3        ; d3.w recoit L1+L3+1
  3033.     cmp.w    #$8000,d3
  3034.     bcs.s     7$
  3035.                 ; ici debordement
  3036. 2$      move.l    #adder3,-(sp)
  3037.     jsr     _err
  3038. addirf  move.l    -4(a6),d0    ; d0 pointe sur resultat
  3039.     movem.l    (sp)+,d2-d3/a2
  3040.     unlk    a6
  3041.     rts
  3042.  
  3043. *===================================================================*
  3044. *                                    *
  3045. *        Addition : reel + reel = reel            *
  3046. *                                    *
  3047. *    entree : a7($4) pointe sur r2 de type R             *
  3048. *         a7($8) pointe sur r1 de type R             *
  3049. *    sortie : d0 pointe sur r2 + r1 de type R (zone creee)    *
  3050. *    precision : L = inf ( L2 , L1 + [(exp2-exp1)/32])        *
  3051. *            si exp2 >= exp1 (sinon echanger r1 et r2)    *
  3052. *                                    *
  3053. *===================================================================*
  3054.  
  3055. _addrr  link    a6,#-16
  3056.     movem.l    d2-d7/a2-a4,-(sp)
  3057.     move.l    8(a6),a2    ; a2 pointe sur r2
  3058.     move.l    12(a6),a1    ; a1 pointe sur r1
  3059.     tst.b    4(a2)
  3060.     bne     1$
  3061.                 ; ici r2 = 0 (r2 + r1 = r1)
  3062. 4$      tst.b    4(a1)
  3063.     bne.s     22$
  3064.                 ; ici r2=r1=0
  3065.     move.l    4(a1),d1
  3066.     cmp.l    4(a2),d1
  3067.     bgt.s     23$
  3068.     move.l    4(a2),d1    ; d1.l contient sup(fexp1,fexp2)
  3069. 23$     moveq    #3,d0
  3070.     bsr     _getr
  3071.     move.l    a0,-8(a6)
  3072.     move.l    d1,4(a0)
  3073.     clr.l    8(a0)
  3074.     bra     addrrf
  3075.                 ; ici r2 = 0 et r1 <> 0
  3076. 22$     moveq    #0,d0
  3077.     move.l    4(a2),d2    ; d2.l contient fexp2
  3078.     move.l    4(a1),d1
  3079.     and.l    #$ffffff,d1    ; d1.l contient fexp1
  3080.     sub.l    d2,d1        ; d1.l recoit exp1-exp2
  3081.     bcc.s     24$
  3082.                 ; ici exp2 >= exp1
  3083.     moveq    #3,d0
  3084.     bsr     _getr
  3085.     move.l    a0,-8(a6)    ; le resultat est 0 avec exposant fexp2
  3086.     move.l    4(a2),4(a0)
  3087.     clr.l    8(a0)
  3088.     bra     addrrf
  3089.                 ; ici exp2 < exp1
  3090. 24$     lsr.l    #5,d1        ; d1.l contient [(exp1-exp2)/32]
  3091.     move.w    2(a1),d0
  3092.     subq.w    #2,d0        ; d0.l contient L1
  3093.     cmp.l    d1,d0
  3094.     ble.s     25$
  3095.     move.l    d1,d0        ; d0.l=inf(L1,[(e1-e2)/32])=L
  3096.     addq.l    #1,d0        ; le resultat est r1 en longueur:
  3097. 25$     addq.l    #2,d0        ; L1 si L1<=[(e1-e2)/32] ou
  3098.     bsr     _getr
  3099.     move.l    a0,-8(a6)
  3100.     addq.l    #4,a1
  3101.     addq.l    #4,a0
  3102.     subq.w    #2,d0
  3103. 27$     move.l    (a1)+,(a0)+
  3104.     dbra    d0,27$
  3105.     bra     addrrf
  3106.                 ; ici r2 <> 0
  3107. 1$      tst.b    4(a1)
  3108.     bne.s     3$
  3109.                 ; ici r1 = 0 (r2 + r1 = r2)
  3110.     exg     a2,a1
  3111.     bra.s     22$
  3112.                 ; ici r1 * r2 <> 0
  3113. 3$      move.b    4(a1),d3
  3114.     move.b    4(a2),d5
  3115.     eor.b    d5,d3        ; d3.b contient : 0 si r1 * r2 > 0
  3116.                 ; et est negatif sinon
  3117.     move.b    d3,-2(a6)    ; sauvegarde du 'signe'
  3118.     move.l    4(a2),d3
  3119.     and.l    #$ffffff,d3    ; d3.l contient fexp2=e2
  3120.     move.l    4(a1),d1
  3121.     and.l    #$ffffff,d1    ; d1.l contient fexp1=e1
  3122.     sub.l    d1,d3        ; d3.l    contient exp2-exp1
  3123.     beq     5$        ; si e2 = e1
  3124.     bcc.s     6$        ; si e2 > e1
  3125.                 ; ici e2 < e1
  3126.     exg     a1,a2
  3127.     neg.l    d3        ; d3.l recoit e1-e2 > 0
  3128.                 ; ici e2-e1 > 0
  3129. 6$      move.w    d3,d4
  3130.     and.w    #31,d4
  3131.     lsr.l    #5,d3        ; e2-e1=32*L3+r ; d4.w,d3.l recoit r,L3
  3132.     moveq    #0,d2
  3133.     move.w    2(a2),d2
  3134.     subq.w    #2,d2        ; d2.l recoit L2
  3135.     cmp.l    d2,d3
  3136.     bcs.s     7$
  3137.                 ; ici L3 >= L2 (r1 + r2 = r2)
  3138.     move.w    2(a2),d0
  3139.     bsr     _getr
  3140.     move.l    a0,-8(a6)
  3141.     addq.l    #4,a2
  3142.     addq.l    #4,a0
  3143.     subq.w    #2,d0
  3144. 28$     move.l    (a2)+,(a0)+
  3145.     dbra    d0,28$
  3146.     bra     addrrf
  3147.                 ; ici L3 < L2
  3148. 7$      moveq    #0,d1
  3149.     move.w    2(a1),d1
  3150.     subq.w    #2,d1        ; d1.l recoit L1
  3151.     move.l    d3,d5
  3152.     add.l    d1,d5        ; d5.l recoit L1 + L3
  3153.     cmp.l    d2,d5
  3154.     bcs.s     8$        ; si L1 + L3 < L2
  3155.                 ; ici L3 < L2 <= L1 + L3
  3156.     move.b    #1,-4(a6)    ; a6($-4) flag contenant :
  3157.                 ; 0 si L1+L3 < L2 faire alors copie r1
  3158.                 ; 1 si L3 < L2 <= L1+L3 et idem
  3159.                 ; 2 si e1 = e2 et alors pas de copie
  3160.     move.w    d2,d0
  3161.     addq.w    #2,d0        ; d0.w recoit l2
  3162.     bsr     _getr        ; allocation L2+2 lgmots pour resultat
  3163.     move.l    a0,-8(a6)    ; adresse resultat dans var. locale
  3164.     move.w    d2,d5
  3165.     sub.w    d3,d5        ; d5.w contient L2 - L3
  3166.     move.w    d5,d0
  3167.     addq.w    #1,d0        ; d0.w contient L2 - L3 + 1
  3168.     bsr     _getr        ; allocation L2-L3+1 pour copie r1 avec
  3169.                 ; un unique longmot code
  3170.     subq.w    #2,d0        ; d0.w contient L2 - L3 - 1
  3171.     move.w    2(a2),d1
  3172.     lea     0(a2,d1.w*4),a2 ; a2 pointe fin de r2
  3173.     bra.s     9$
  3174.                 ; ici L1 + L3 < L2
  3175. 8$      clr.b    -4(a6)             ; a6($-4) mis a 0
  3176.     move.w    d5,d0
  3177.     addq.w    #3,d0        ; d0.w contient L1 + L3 + 3
  3178.     bsr     _getr        ; allocation pour resultat
  3179.     move.l    a0,-8(a6)    ; adresse resultat dans var. locale
  3180.     lea     0(a2,d0.w*4),a2 ; a2 pointe ou necessaire !!
  3181.     move.w    2(a1),d5    ; d5.w contient L1 + 2
  3182.     move.w    d5,d0        ; d0.w contient L1 + 2
  3183.     subq.w    #2,d5        ; d5.w contient L1
  3184.     bsr     _getr        ; allocation L1+2 pour copie r1 avec
  3185.                 ; un  seul lgmot code
  3186.     subq.w    #3,d0        ; d0.w contient L1 - 1
  3187. 9$      move.l    a0,-12(a6)     ; adresse copie r1 dans var. locale
  3188.     addq.l    #4,a0
  3189.     move.l    a0,a3        ; a0 et a3 pointent sur debut copie
  3190.     addq.l    #8,a1        ; a1 pointe debut mantisse r1
  3191. 29$     move.l    (a1)+,(a0)+
  3192.     dbra    d0,29$        ; boucle copie r1
  3193.     tst.w    d4        ; test de r = nb de shifts
  3194.     bne.s     10$
  3195.                 ; ici r = 0 ; pas de shift a faire
  3196.                 ; a0 pointe fin copie r1
  3197.                 ; a3 pointe debut mantisse copie r1
  3198.     moveq    #0,d7
  3199.     move.w    -2(a3),d7
  3200.     subq.w    #1,d7        ; d7.w contient longueur mantisse copie
  3201.     move.w    d7,d2
  3202.     subq.w    #1,d2        ; d2.w = compteur boucle addition
  3203.     lea     0(a3,d7.w*4),a3 ; a3 pointe fin copie r1
  3204.     move.l    a3,a1        ; a1 aussi
  3205.     bra.s     11$
  3206.                 ; ici r <> 0 ; shift a faire
  3207. 10$     subq.w    #1,d5
  3208.     move.w    d5,d2        ; d5.w et d2.w = compteur boucle shift
  3209.     move.l    #-1,d6
  3210.     lsr.l    d4,d6        ; masque de shift:0...01...1; avec r '0'
  3211.     moveq    #0,d0
  3212.                 ; boucle de shift de copie de r1
  3213. 12$     move.l    (a3),d7
  3214.     ror.l    d4,d7
  3215.     move.l    d7,d1
  3216.     and.l    d6,d1
  3217.     sub.l    d1,d7
  3218.     add.l    d1,d0
  3219.     move.l    d0,(a3)+
  3220.     move.l    d7,d0
  3221.     dbra    d5,12$
  3222.     move.l    a3,a1
  3223.     tst.b    -4(a6)
  3224.     bne.s     11$         ; si a6($-4) <> 0
  3225.                 ; ici a6($-4) = 0
  3226.     move.l    d0,(a1)+
  3227.     addq.w    #1,d2        ; d2.w = compteur boucle addition
  3228. 11$     move.l    -8(a6),a0    ; a0 pointe sur resultat
  3229.     moveq    #0,d1
  3230.     move.w    2(a0),d1
  3231.     lea     0(a0,d1.w*4),a0 ; a0 pointe fin du resultat
  3232.     bra.s     14$
  3233.                 ; ici e1 = e2
  3234. 5$      move.b    #2,-4(a6)    ; a6($-4) recoit 2
  3235.     move.l    d1,-16(a6)     ; a6($-16) recoit e1=e2 biaise
  3236.     move.w    2(a1),d0
  3237.     cmp.w    2(a2),d0
  3238.     bcs.s     15$
  3239.     move.w    2(a2),d0
  3240. 15$     bsr     _getr        ; allocation inf (l1,l2) pour resultat
  3241.     move.l    a0,-8(a6)    ; adresse du resultat dans var. locale
  3242.     moveq    #0,d2
  3243.     move.w    d0,d2
  3244.     move.l    d2,d0
  3245.     subq.w    #3,d2
  3246.     moveq    #0,d3
  3247.     move.l    a2,a4
  3248.     move.l    a1,a3
  3249.     lea     0(a0,d0.w*4),a0 ; a0 pointe fin resultat
  3250.     lea     0(a1,d0.w*4),a1 ; a1 pointe fin de r1 ou copie
  3251.     lea     0(a2,d0.w*4),a2 ; a2 pointe fin de r2
  3252.  
  3253.                 ; zone des boucles d'addition
  3254.  
  3255.                 ; conditions initiales :
  3256.                 ; a0 pointe fin resultat
  3257.                 ; a1 pointe fin r1 ou copie
  3258.                 ; a2 pointe fin r2
  3259.                 ; d2.w contient L4-1
  3260.                 ; d3.w contient L3 avec L3+L4=long.res.
  3261. 14$     sub.l    d4,d4        ; initialisation bit X
  3262.     tst.b    -2(a6)     ; test du signe de r1*r2
  3263.     bne     surr
  3264.                 ; ici r1 * r2 > 0
  3265.                 ; 1ere boucle d'addition
  3266. 16$     move.l    -(a1),d1
  3267.     move.l    -(a2),d5
  3268.     addx.l    d5,d1
  3269.     move.l    d1,-(a0)
  3270.     dbra    d2,16$
  3271.     roxr.w    d4,d0        ; remise a jour du bit C
  3272.     bcc.s     17$         ; si pas de carry
  3273.     bra.s     18$         ; si carry
  3274.                 ; 2eme boucle:propagation carry
  3275. 19$     move.l    -(a2),d5
  3276.     addx.l    d4,d5
  3277.     move.l    d5,-(a0)
  3278.     roxr.w    d4,d0        ; mise a jour bit C
  3279. 18$     dbcc    d3,19$
  3280.     bcs.s     20$         ; si carry finale
  3281.     bra.s     17$
  3282.                 ; 3eme boucle:recopie reste mantisse r2
  3283. 30$     move.l    -(a2),-(a0)
  3284. 17$     dbra    d3,30$
  3285.     move.l    -(a2),-(a0)    ; mise signe et exposant:celui de r2
  3286.     cmp.b    #2,-4(a6)
  3287.     beq.s     addrrf        ; si a6($-4) = 2
  3288.                 ; ici rendre copie de r1
  3289.     move.l    -12(a6),a0
  3290.     bsr     _giv
  3291.     bra.s     addrrf
  3292.                 ; ici carry finale
  3293. 20$     move.l    -(a2),d1
  3294.     and.l    #$ffffff,d1
  3295.     addq.l    #1,d1        ; d1.l recoit fexp resultat
  3296.     cmp.l    #$1000000,d1
  3297.     blt.s     2$
  3298.                 ; ici fexp>=2^24 : erreur
  3299.     move.l    #adder4,-(sp)
  3300.     jsr     _err
  3301.                 ; ici non debordement
  3302. 2$      cmp.b    #2,-4(a6)
  3303.     beq.s     13$
  3304.                 ; ici rendre copie de r1
  3305.     move.l    a0,a3
  3306.     move.l    -12(a6),a0
  3307.     bsr     _giv
  3308.     move.l    a3,a0
  3309. 13$     move.l    d1,-4(a0)
  3310.     move.b    (a2),-4(a0)     ; mise a jour exp et sign resultat
  3311.     move.w    -6(a0),d2
  3312.     subq.w    #3,d2        ; compteur de shift
  3313.     move.w    #-1,d0
  3314.     move.w    d0,ccr        ; mise a 1 des bit x et c
  3315. 31$     roxr.w    (a0)+
  3316.     roxr.w    (a0)+        ; boucle de mise de retenue finale et
  3317.     dbra    d2,31$        ; shift de 1 vers la droite mantisse
  3318. addrrf  move.l    -8(a6),d0    ; d0 pointe sur resultat
  3319.     movem.l    (sp)+,d2-d7/a2-a4
  3320.     unlk    a6
  3321.     rts
  3322.                 ; ici faire une soustraction
  3323.                 ; pour conditions initiales cf.plus haut
  3324. surr     moveq    #0,d6
  3325.     move.w    d2,d6
  3326.     move.w    d2,d7
  3327.     add.w    d3,d7
  3328.     addq.w    #3,d7
  3329.     cmp.b    #2,-4(a6)
  3330.     bne.s     1$
  3331.                 ; ici e2 = e1:comparer les mantisses
  3332.     addq.l    #8,a3
  3333.     addq.l    #8,a4
  3334. 12$     cmpm.l    (a3)+,(a4)+
  3335.     dbne    d2,12$
  3336.     bhi.s     1$        ; si |r2| > |r1|
  3337.     bne.s     2$        ; si |r2| < |r1|
  3338.                 ; ici |r2| = |r1| et donc r2 + r1 = 0
  3339.     move.l    -8(a6),a0    ; le resultat est 0 avec comme exposant
  3340.     moveq    #0,d2        ; -32*inf(l1,l2)+e1
  3341.     move.w    2(a0),d2
  3342.     subq.w    #2,d2
  3343.     lsl.l    #5,d2    
  3344.     neg.l    d2
  3345.     add.l    -16(a6),d2     ; ajouter e1 biaise
  3346.     bpl.s     15$
  3347.     move.l    #adder5,-(sp)    ; underflow dans R+R
  3348.     jsr     _err
  3349. 15$     cmp.l    #$1000000,d2
  3350.     blt.s     16$
  3351.                 ; ici fexp>=2^24 : erreur overflow dans R+R
  3352.     move.l    #adder4,-(sp)
  3353.     jsr     _err
  3354. 16$     bsr     _giv
  3355.     moveq    #3,d0
  3356.     bsr     _getr
  3357.     move.l    a0,-8(a6)
  3358.     move.l    d2,4(a0)
  3359.     clr.l    8(a0)
  3360.     bra.s     addrrf
  3361.                 ; ici |r2| < |r1| : echanger r2 et r1
  3362. 2$      exg     a1,a2
  3363.                 ; ici |r2| > |r1|
  3364. 1$      sub.w    d2,d6
  3365.     sub.l    d4,d4        ; initialisation bit X
  3366.                 ; 1ere boucle de soustraction
  3367. 3$      move.l    -(a2),d0
  3368.     move.l    -(a1),d5
  3369.     subx.l    d5,d0
  3370.     move.l    d0,-(a0)
  3371.     dbra    d2,3$
  3372.     roxr.w    d4,d0        ; remise ajour bit C
  3373.     bra.s     4$
  3374.                 ; 2eme boucle:propagation carry
  3375. 5$      move.l    -(a2),d5
  3376.     subx.l    d4,d5
  3377.     move.l    d5,-(a0)
  3378.     roxr.w    d4,d0
  3379. 4$      dbcc    d3,5$
  3380.     bra.s     6$
  3381.                 ; 3eme boucle:copie reste mantisse r2
  3382. 13$     move.l    -(a2),-(a0)
  3383. 6$      dbra    d3,13$
  3384.     moveq    #0,d3
  3385.     moveq    #-1,d2
  3386.     move.w    d2,d3
  3387. 14$     tst.l    (a0)+
  3388.     dbne    d2,14$        ; chasse aux '0' du resultat provisoire
  3389.                 ; a0 pointe sur 1er lgmot non nul
  3390.     sub.w    d2,d3        ; d3.w    contient de lgmots nuls
  3391.     add.w    d6,d3
  3392.     sub.l    #12,a0        ; a0 pointe sur resultat
  3393.     move.l    a0,-8(a6)
  3394.     move.l    a0,a1        ; a1 aussi
  3395.     cmp.b    #2,-4(a6)
  3396.     beq.s     7$        ; si pas de copie faite
  3397.                 ; ici rendre copie
  3398.     move.l    -12(a6),a0
  3399.     bsr     _giv
  3400. 7$      moveq    #0,d0
  3401.     move.w    d3,d0
  3402.     lsl.l    #2,d0        ; d0.l = nb d'octets a 0 du result.
  3403.     add.l    d0,_avma    ; mise a jour pile PARI(rendre d3 lgmot)
  3404.     move.l    a1,a0        ; a0 pointe sur resultat final
  3405.     move.w    #$201,(a0)
  3406.     sub.w    d3,d7
  3407.     move.w    d7,2(a0)    ; mise a jour 1er lgmot code resultat
  3408.     lsl.l    #5,d3
  3409.     move.l    8(a0),d0
  3410.     bfffo    d0{0:32},d1    ; d1.l contient nb de shifts=r
  3411.     lsl.l    d1,d0        ; normalisation 1er lgmot mantisse
  3412.     add.l    d1,d3
  3413.     lsl.l    #2,d6
  3414.     sub.l    d6,a2
  3415.     move.l    -4(a2),d2
  3416.     and.l    #$ffffff,d2
  3417.     sub.l    d3,d2
  3418.     move.l    d2,4(a0)    ; calcul et mise exposant resultat
  3419.     move.b    -4(a2),4(a0)    ; mise signe resultat
  3420.     tst.b    d1
  3421.     bne.s     8$        ; si r <> 0
  3422.     bra.s     9$        ; si r = 0
  3423. 8$      moveq    #1,d6
  3424.     lsl.l    d1,d6
  3425.     subq.l    #1,d6        ; masque de shift
  3426.     addq.l    #8,a1
  3427.     subq.w    #3,d7        ; d7.w    contient L-1
  3428.     bra.s     10$
  3429.                 ; boucle de shift vers la gauche
  3430. 11$     move.l  4(a1),d2
  3431.     rol.l    d1,d2
  3432.     move.l    d2,d3
  3433.     and.l    d6,d3
  3434.     sub.l    d3,d2
  3435.     add.l    d3,d0
  3436.     move.l    d0,(a1)+
  3437.     move.l    d2,d0
  3438. 10$     dbra    d7,11$
  3439.     move.l    d0,(a1)
  3440. 9$      bra     addrrf
  3441.  
  3442.  
  3443.  
  3444.  
  3445.  
  3446. *********************************************************************
  3447. *********************************************************************
  3448. ***                                   ***
  3449. ***             PROGRAMMES DE SOUSTRACTION          ***
  3450. ***                                   ***
  3451. *********************************************************************
  3452. *********************************************************************
  3453.  
  3454.  
  3455.  
  3456.  
  3457.  
  3458. *===================================================================*
  3459. *                                    *
  3460. *            Soustraction generale            *
  3461. *                                    *
  3462. *    entree : a7($4) pointe sur n2 de type I ou R        *
  3463. *         a7($8) pointe sur n1 de type I ou R        *
  3464. *    sortie : d0 pointe sur n2 - n1 de type I ou R (zone creee)    *
  3465. *    interdit : type S                        *
  3466. *                                    *
  3467. *===================================================================*
  3468.  
  3469. _mpsub  cmp.b    #1,([8,sp])
  3470.     bne.s     1$
  3471.     cmp.b    #1,([4,sp])
  3472.     beq     _subii
  3473.     bra     _subri
  3474. 1$      cmp.b    #1,([4,sp])
  3475.     beq     _subir
  3476.     bra     _subrr
  3477.  
  3478. *===================================================================*
  3479. *                                    *
  3480. *            Soustraction (par valeur)            *
  3481. *                                    *
  3482. *    entree : a7($4) pointe sur n2 de type I ou R        *
  3483. *         a7($8) pointe sur n1 de type I ou R        *
  3484. *         a7($12) pointe sur n3 de type I ou R        *
  3485. *    sortie : la zone pointee par a7($12) contient n2 - n1    *
  3486. *    interdit : type S                        *
  3487. *                                    *
  3488. *===================================================================*
  3489.  
  3490. _mpsubz lea     _mpsub,a0
  3491.     bra     mpopz
  3492.  
  3493.                 ; soustraction S-S=I ou R
  3494.  
  3495. _subssz lea     _subss,a0
  3496.     bra     mpopz
  3497.  
  3498.                 ; soustraction S-I=I ou R
  3499.  
  3500. _subsiz lea     _subsi,a0
  3501.     bra     mpopz
  3502.  
  3503.                 ; soustraction S-R=R sinon erreur
  3504.  
  3505. _subsrz lea     _subsr,a0
  3506.     bra     mpopz
  3507.  
  3508.                 ; soustraction I-S=I ou R
  3509.  
  3510. _subisz lea     _subis,a0
  3511.     bra     mpopz
  3512.  
  3513.                 ; soustraction I-I=I ou R
  3514.  
  3515. _subiiz lea     _subii,a0
  3516.     bra     mpopz
  3517.  
  3518.                 ; soustraction I-R=R sinon erreur
  3519.  
  3520. _subirz lea     _subir,a0
  3521.     bra     mpopz
  3522.  
  3523.                 ; soustraction R-S=R sinon erreur
  3524.  
  3525. _subrsz lea     _subrs,a0
  3526.     bra     mpopz
  3527.  
  3528.                 ; soustraction R-I=R sinon erreur
  3529.  
  3530. _subriz lea     _subri,a0
  3531.     bra     mpopz
  3532.  
  3533.                 ; soustraction R-R=R sinon erreur
  3534.  
  3535. _subrrz lea     _subrr,a0
  3536.     bra     mpopz
  3537.  
  3538. *===================================================================*
  3539. *                                    *
  3540. *    Soustraction : entier court - entier court = entier     *
  3541. *                                    *
  3542. *    entree : a7($4) contient s2 de type S            *
  3543. *         a7$(8) contient s1 de type S            *
  3544. *    sortie : d0 pointe sur s2 - s1 de type I (zone creee)    *
  3545. *    remarque : s2 - s1 = s0 est interdit            *
  3546. *                                    *
  3547. *===================================================================*
  3548.  
  3549. _subss  link    a6,#-12
  3550.     move.l    12(a6),d1    ; d1.l recoit s1
  3551.     neg.l    d1        ; d1.l recoit -s1
  3552.     bvs.s     1$
  3553.                 ; ici |s1| <= 2^31-1
  3554.     move.l    d1,-(sp)     ; empilage -s1
  3555.     move.l    8(a6),-(sp)     ; empilage s2
  3556.     bsr     _addss        ; calcul se s2+(-s1)
  3557.     bra.s     subssf
  3558.                 ; ici s1 = -2^31
  3559. 1$      move.l    #$1000003,-12(a6)
  3560.     move.l    #$1000003,-8(a6)
  3561.     move.l    #$80000000,-4(a6) ; creation de 2^31 type entier
  3562.     pea     -12(a6)            ; empilage adresse de 2^31
  3563.     move.l    8(a6),-(sp)     ; empilage s2
  3564.     bsr     _addsi
  3565. subssf  unlk    a6
  3566.     rts
  3567.  
  3568. *===================================================================*
  3569. *                                    *
  3570. *        Soustraction : entier - entier = entier         *
  3571. *                                    *
  3572. *    entree : a7($4) pointe sur i2 de type I             *
  3573. *         a7($8) pointe sur i1 de type I             *
  3574. *    sortie : d0 pointe sur i2 - i1 de type I (zone creee)    *
  3575. *                                    *
  3576. *===================================================================*
  3577.  
  3578. _subii  link    a6,#-4
  3579.     move.l    12(a6),-(sp)    ; empilage adresse i1
  3580.     move.l    8(a6),-(sp)     ; empilage adresse i2
  3581.     move.l    12(a6),a0    ; a0 pointe sur i1
  3582.     neg.b    4(a0)        ; changer signe de i1
  3583.     move.l    a0,-4(a6)
  3584.     bsr     _addii
  3585.     move.l    -4(a6),a0
  3586.     neg.b    4(a0)        ; remettre signe de i1
  3587.     unlk    a6
  3588.     rts
  3589.  
  3590. *===================================================================*
  3591. *                                    *
  3592. *        Soustraction : reel - reel = reel            *
  3593. *                                    *
  3594. *    entree : a7($4) pointe sur r2 de type R             *
  3595. *         a7($8) pointe sur r1 de type R             *
  3596. *    sortie : d0 pointe sur r2 - r1 de type R (zone creee)    *
  3597. *                                    *
  3598. *===================================================================*
  3599.  
  3600. _subrr  link    a6,#-4        ; voir commentaires de _subii
  3601.     move.l    12(a6),-(sp)
  3602.     move.l    8(a6),-(sp)
  3603.     move.l    12(a6),a0
  3604.     neg.b    4(a0)
  3605.     move.l    a0,-4(a6)
  3606.     bsr     _addrr
  3607.     move.l    -4(a6),a0
  3608.     neg.b    4(a0)
  3609.     unlk    a6
  3610.     rts
  3611.  
  3612. *===================================================================*
  3613. *                                    *
  3614. *    Soustraction : entier court - entier = entier        *
  3615. *                                    *
  3616. *    entree : a7($4) contient s2 de type S            *
  3617. *         a7($8) pointe sur i1 de type I             *
  3618. *    sortie : d0 pointe sur s2 - i1 de type I            *
  3619. *                                    *
  3620. *===================================================================*
  3621.  
  3622. _subsi  link    a6,#-4        ; voir commentaires de _subii
  3623.     move.l    12(a6),-(sp)
  3624.     move.l    8(a6),-(sp)
  3625.     move.l    12(a6),a0
  3626.     neg.b    4(a0)
  3627.     move.l    a0,-4(a6)
  3628.     bsr     _addsi
  3629.     move.l    -4(a6),a0
  3630.     neg.b    4(a0)
  3631.     unlk    a6
  3632.     rts
  3633.  
  3634. *===================================================================*
  3635. *                                    #    
  3636. *        Soustraction : entier court - reel = reel        *
  3637. *                                    *
  3638. *    entree : a7($4) contient s2 de type S            *
  3639. *         a7($8) pointe sur r1 de type R             *
  3640. *    sortie : d0 pointe sur s2 - r1 de type R (zone creee)    *
  3641. *                                    *
  3642. *===================================================================*
  3643.  
  3644. _subsr  link    a6,#-4        ; voir commentaires de _subii
  3645.     move.l    12(a6),-(sp)
  3646.     move.l    8(a6),-(sp)
  3647.     move.l    12(a6),a0
  3648.     neg.b    4(a0)
  3649.     move.l    a0,-4(a6)
  3650.     bsr     _addsr
  3651.     move.l    -4(a6),a0
  3652.     neg.b    4(a0)
  3653.     unlk    a6
  3654.     rts
  3655.  
  3656. *===================================================================*
  3657. *                                    *
  3658. *    Soustraction : entier - entier court = entier        *
  3659. *                                    *
  3660. *    entree : a7($4) pointe sur i1 de type I             *
  3661. *         a7($8) contient s2 de type S            *
  3662. *    sortie : d0 pointe sur i1 - s2 de type I (zone creee)    *
  3663. *                                    *
  3664. *===================================================================*
  3665.  
  3666. _subis  link    a6,#-12     ; voir commentaires de _subss
  3667.     move.l    8(a6),-(sp)
  3668.     move.l    12(a6),d1
  3669.     neg.l    d1
  3670.     bvs.s     1$
  3671.     move.l    d1,-(sp)
  3672.     bsr     _addsi
  3673.     bra.s     subisf
  3674. 1$      move.l    #$1000003,-12(a6)
  3675.     move.l    #$1000003,-8(a6)
  3676.     move.l    #$80000000,-4(a6)
  3677.     pea     -12(a6)
  3678.     bsr     _addii
  3679. subisf  unlk    a6
  3680.     rts
  3681.  
  3682. *===================================================================*
  3683. *                                    *
  3684. *        Soustraction : entier - reel = reel         *
  3685. *                                    *
  3686. *    entree : a7($4) pointe sur i2 de type I             *
  3687. *         a7($8) pointe sur r1 de type R             *
  3688. *    sortie : d0 pointe sur i2 - r1 de type R (zone creee)    *
  3689. *                                    *
  3690. *===================================================================*
  3691.  
  3692. _subir  link    a6,#-4        ; voir commentaires de _subii
  3693.     move.l    12(a6),-(sp)
  3694.     move.l    8(a6),-(sp)
  3695.     move.l    12(a6),a0
  3696.     neg.b    4(a0)
  3697.     move.l    a0,-4(a6)
  3698.     bsr     _addir
  3699.     move.l    -4(a6),a0
  3700.     neg.b    4(a0)
  3701.     unlk    a6
  3702.     rts
  3703.  
  3704. *===================================================================*
  3705. *                                    *
  3706. *        Soustraction : reel - entier = reel         *
  3707. *                                    *
  3708. *    entree : a7($4) pointe sur r1 de type R             *
  3709. *         a7($8) pointe sur i2 de type I             *
  3710. *    sortie : d0 pointe sur r2 - i1 de type R (zone creee)    *
  3711. *                                    *
  3712. *===================================================================*
  3713.  
  3714. _subri  link    a6,#-4        ; voir commentaires de _subii
  3715.     move.l    8(a6),-(sp)
  3716.     move.l    12(a6),-(sp)
  3717.     move.l    12(a6),a0
  3718.     neg.b    4(a0)
  3719.     move.l    a0,-4(a6)
  3720.     bsr     _addir
  3721.     move.l    -4(a6),a0
  3722.     neg.b    4(a0)
  3723.     unlk    a6
  3724.     rts
  3725.  
  3726. *===================================================================*
  3727. *                                    *
  3728. *    Soustraction : reel - entier court = reel            *
  3729. *                                    *
  3730. *    entree : a7($4) pointe sur r2 de type R             *
  3731. *         a7($8) contient s1 de type S            *
  3732. *    sortie : d0 pointe sur r2 - s1 de type R (zone creee)    *
  3733. *                                    *
  3734. *===================================================================*
  3735.  
  3736. _subrs  link    a6,#-12     ; voir commentaires de _subss
  3737.     move.l    8(a6),-(sp)
  3738.     move.l    12(a6),d1
  3739.     neg.l    d1
  3740.     bvs.s     1$
  3741.     move.l    d1,-(sp)
  3742.     bsr     _addsr
  3743.     bra.s     subsrf
  3744. 1$      move.l    #$1000003,-12(a6)
  3745.     move.l    #$1000003,-8(a6)
  3746.     move.l    #$80000000,-4(a6)
  3747.     pea     -12(a6)
  3748.     bsr     _addir
  3749. subsrf  unlk    a6
  3750.     rts
  3751.  
  3752.  
  3753.  
  3754.  
  3755.  
  3756. *********************************************************************
  3757. *********************************************************************
  3758. ***                                   ***
  3759. ***             PROGRAMMES DE MULTIPLICATION          ***
  3760. ***                                   ***
  3761. *********************************************************************
  3762. *********************************************************************
  3763.  
  3764.  
  3765.  
  3766.  
  3767.  
  3768. *===================================================================*
  3769. *                                    *
  3770. *            Multiplication generale             *
  3771. *                                    *
  3772. *    entree : a7($4) pointe sur n2 de type I ou R        *
  3773. *         a7($8) pointe sur n1 de type I ou R        *
  3774. *    sortie : d0 pointe sur n2 * n1 de type I ou R (zone cree)    *
  3775. *    interdit : type S                        *
  3776. *    precision : voir routines specialisees            *
  3777. *                                    *
  3778. *===================================================================*
  3779.  
  3780. _mpmul  move.l    4(sp),a0
  3781.     move.l    8(sp),a1    ; a1 et a0 pointent sur n1 et n2
  3782.     move.b    (a0),d0
  3783.     move.b    (a1),d1        ; d1.b et d0.b contiennent T1 et T2
  3784.     cmp.b    d1,d0
  3785.     ble.s     1$
  3786.                 ; ici T2 > T1
  3787.     exg     a1,a0
  3788.     exg     d1,d0
  3789.     move.l    a0,4(sp)
  3790.     move.l    a1,8(sp)
  3791.                 ; ici T2 <= T1
  3792. 1$      cmp.b    #1,d1
  3793.     beq     _mulii        ; ici T1 = T2 = I
  3794. 2$      cmp.b    #2,d0
  3795.     beq     _mulrr        ; ici T1 = T2 = R
  3796.     bra     _mulir
  3797.  
  3798. *===================================================================*
  3799. *                                    *
  3800. *        Multiplication (par valeur)             *
  3801. *                                    *
  3802. *    entree : a7($4) pointe sur n2 de type I ou R        *
  3803. *         a7($8) pointe sur n1 de type I ou R        *
  3804. *         a7($12) pointe sur n3 de type I ou R        *
  3805. *    sortie : la zone pointee par a7($12) contient n2*n1     *
  3806. *    interdit : type S                        *
  3807. *                                    *
  3808. *===================================================================*
  3809.  
  3810. _mpmulz lea     _mpmul,a0
  3811.     bra     mpopz
  3812.  
  3813.                 ; multiplication S*S=I ou R
  3814.  
  3815. _mulssz lea     _mulss,a0
  3816.     bra     mpopz
  3817.  
  3818.                 ; multiplication S*I=I ou R
  3819.  
  3820. _mulsiz lea     _mulsi,a0
  3821.     bra     mpopz
  3822.  
  3823.                 ; multiplication S*R=R sinon erreur
  3824.  
  3825. _mulsrz lea     _mulsr,a0
  3826.     bra     mpopz
  3827.  
  3828.                 ; multiplication I*I=I ou R
  3829.  
  3830. _muliiz lea     _mulii,a0
  3831.     bra     mpopz
  3832.  
  3833.                 ; multiplication I*R=R sinon erreur
  3834.  
  3835. _mulirz lea     _mulir,a0
  3836.     bra     mpopz
  3837.  
  3838.                 ; multiplication R*R=R sinon erreur
  3839.  
  3840. _mulrrz lea     _mulrr,a0
  3841.     bra     mpopz
  3842.  
  3843. *===================================================================*
  3844. *                                    *
  3845. *    Multiplication : entier court * entier court = entier    *
  3846. *                                    *
  3847. *    entree : a7($4) contient s2 de type S            *
  3848. *         a7($8) contient s1 de type S            *
  3849. *    sortie : d0 pointe sur s2 * s1 de type I (zone creee)    *
  3850. *                                    *
  3851. *===================================================================*
  3852.  
  3853. _mulss  link    a6,#-2
  3854.     movem.l    d2-d4,-(sp)
  3855.     move.l    8(a6),d2    ; d2.l contient s2
  3856.     bne.s     1$
  3857. 2$      move.w    #2,d0        ; ici s2 ou s1 = 0
  3858.     bsr     _geti
  3859.     move.l    #2,4(a0)
  3860.     bra.s     mulssf
  3861.                 ; ici s2 <> 0
  3862. 1$      move.l    d2,d4
  3863.     bpl.s     3$
  3864.     neg.l    d2        ; d2.l contient |s2|
  3865. 3$      move.l    12(a6),d1    ; d1.l contient s1
  3866.     beq.s     2$        ; si s1=0
  3867.     eor.l    d1,d4        
  3868.     tst.l    d1
  3869.     bpl.s     4$
  3870.     neg.l    d1        ; d1.l contient |s1|
  3871. 4$      mulu.l    d1,d3:d2
  3872.     move.w    #4,d0
  3873.     tst.l    d3
  3874.     bne.s     5$
  3875.     move.w    #3,d0        ; d0 recoit 3 ou 4 pour allocation
  3876. 5$      bsr     _geti
  3877.     move.w    2(a0),6(a0)    ; met long effect.
  3878.     move.b    #1,4(a0)    ; met signe
  3879.     tst.l    d4
  3880.     bpl.s     6$
  3881.     neg.b    4(a0)
  3882. 6$      tst.l    d3
  3883.     bne.s     7$
  3884.     move.l    d2,8(a0)
  3885.     bra.s     mulssf
  3886. 7$      move.l    d3,8(a0)
  3887.     move.l    d2,12(a0)
  3888. mulssf  move.l    a0,d0
  3889.     movem.l    (sp)+,d2-d4
  3890.     unlk    a6
  3891.     rts
  3892.  
  3893.  
  3894. _mulmodll move.l 4(sp),d1
  3895.     mulu.l    8(sp),d0:d1
  3896.     divu.l    12(sp),d0:d1
  3897.     rts
  3898.  
  3899.  
  3900. *===================================================================*
  3901. *                                    *
  3902. *    Multiplication : entier court * entier = entier         *
  3903. *                                    *
  3904. *    entree : a7($4) contient s2 de type S            *
  3905. *         a7($8) pointe sur i1 de type I             *
  3906. *    sortie : d0 pointe sur s2 * i1    de type I (zone creee)    *
  3907. *                                    *
  3908. *===================================================================*
  3909.  
  3910. _mulsi  link    a6,#0
  3911.     movem.l    d2-d6/a2,-(sp)
  3912.     move.l    8(a6),d2    ; d2.l contient s2
  3913.     bne.s     1$
  3914.                 ; ici s2 = 0 ou i1 = 0
  3915. 2$      move.w    #2,d0
  3916.     bsr     _geti
  3917.     move.l    #2,4(a0)
  3918.     bra.s     mulsif
  3919.                 ; ici s2 <> 0
  3920. 1$      bpl.s     6$
  3921.     neg.l    d2        ; d2 contient |s2|
  3922. 6$      move.l    12(a6),a1    ; a1 pointe sur i1
  3923.     tst.b    4(a1)
  3924.     beq.s     2$        ; si i1 = 0
  3925.                 ; ici i1 <> 0 et s2 <> 0
  3926.     move.w    6(a1),d0    ; d0.w contient le1
  3927.     bsr     _geti
  3928.     lea     0(a0,d0.w*4),a2 ; a2 pointe apres resultat (i0)
  3929.     lea     0(a1,d0.w*4),a1 ; a1 pointe apres i1
  3930.     subq.w    #3,d0
  3931.     moveq    #0,d6
  3932.     moveq    #0,d5        ; initialisation retenue
  3933.                 ; debut boucle multiplication
  3934. 3$      move.l    -(a1),d4
  3935.     mulu.l    d2,d3:d4
  3936.     add.l    d5,d4
  3937.     addx.l    d6,d3
  3938.     move.l    d4,-(a2)
  3939.     move.l    d3,d5
  3940.     dbra    d0,3$
  3941.     beq.s     5$
  3942.                 ; ici retenue finale
  3943.     move.w    #1,d0
  3944.     bsr     _geti
  3945.     move.w    6(a0),d0
  3946.     addq.w    #1,d0        ; d0.w contient le(i0)
  3947.     bvc.s     4$
  3948.                 ; ici debordement
  3949.     move.l    #muler3,-(sp)
  3950.     jsr     _err
  3951. 4$      move.w    d0,2(a0)    ; mise longueur
  3952.     move.l    d5,8(a0)    ; mise retenue
  3953. 5$      move.w    2(a0),6(a0)    ; mise le(i0)
  3954.     move.b    -4(a1),4(a0)
  3955.     tst.l    8(a6)
  3956.     bpl.s     mulsif
  3957.     neg.b    4(a0)        ; mise signe
  3958. mulsif  move.l    a0,d0    
  3959.     movem.l    (sp)+,d2-d6/a2
  3960.     unlk    a6
  3961.     rts
  3962.  
  3963. *===================================================================*
  3964. *                                    *
  3965. *        Multiplication : entier court * reel = reel     *
  3966. *                                    *
  3967. *    entree : a7($4) contient s2 de type S            *
  3968. *         a7($8) pointe sur r1 de type R             *
  3969. *    sortie : d0 pointe sur s2 * r1 de type R            *
  3970. *             de longueur L = L1 (zone creee)        *
  3971. *                                    *
  3972. *===================================================================*
  3973.  
  3974. _mulsr  link    a6,#-4
  3975.     movem.l    d2-d6/a2,-(sp)
  3976.     move.l    8(a6),d2    ; d2.l contient s2
  3977.     bne.s     1$
  3978.                 ; ici s2 = 0
  3979.     move.l    #2,d0
  3980.     bsr     _geti
  3981.     move.l    #2,4(a0)
  3982.     move.l    a0,d0
  3983.     bra     mulsrf1
  3984.                 ; ici s2 <> 0
  3985. 1$      move.l    12(a6),a1    ; a1 pointe sur r1
  3986.     tst.b    4(a1)
  3987.     bne.s     2$
  3988.                 ; ici r1 = 0
  3989.     moveq    #3,d0
  3990.     bsr     _getr
  3991.     tst.l    d2
  3992.     bpl.s     2$
  3993.     neg.l    d2
  3994.     bfffo    d2{0:32},d0
  3995.     move.l    4(a1),d1
  3996.     add.l    #31,d1
  3997.     sub.l    d0,d1
  3998.     cmp.l    #$1000000,d1
  3999.     bcc     11$
  4000.     move.l    d1,4(a0)
  4001.     clr.l    8(a0)
  4002.     move.l    a0,d0
  4003.     bra     mulsrf1
  4004. 2$      move.w    2(a1),d0
  4005.     bsr     _getr        ; allocation memoire pour resultat
  4006.     move.l    a0,-4(a6)    ; sauvegarde adr. resultat ds var.locale
  4007.                 ; ici s2 et r1 <> 0
  4008.     move.l    d2,d4
  4009.     bpl.s     3$
  4010.     neg.l    d2        ; d2.l contient |s2|
  4011. 3$      cmp.l    #1,d2
  4012.     bne.s     4$
  4013.                 ; ici |s2| = 1
  4014.     addq.l    #4,a0
  4015.     addq.l    #4,a1
  4016.     subq.w    #2,d0
  4017. 5$      move.l    (a1)+,(a0)+
  4018.     dbra    d0,5$        ; copie de r1 dans resultat
  4019.     move.l    -4(a6),a0
  4020.     tst.l    d4
  4021.     bpl     mulsrf
  4022.     neg.b    4(a0)        ; mise signe
  4023.     bra     mulsrf
  4024.                 ; ici |s2| <> 1 et 0 , r1 <> 0
  4025. 4$      move.b    4(a1),4(a0)
  4026.     tst.l    d4
  4027.     bpl.s     6$
  4028.     neg.b    4(a0)        ; mise signe
  4029. 6$      lea     0(a0,d0.w*4),a0 ; a0 pointe apres resultat
  4030.     lea     0(a1,d0.w*4),a1 ; a1 pointe apres r1
  4031.     subq.w    #3,d0        ; d0.w contient L1-1
  4032.     move.w    d0,d4        ; d4.w idem
  4033.     move.w    d4,d6
  4034.     moveq    #0,d1        ; d1 a 0 pour les addx
  4035.     moveq    #0,d0        ; initialisation retenue d0
  4036.                 ; boucle de multiplication :
  4037. 7$      move.l    -(a1),d5
  4038.     mulu.l    d2,d3:d5
  4039.     add.l    d0,d5
  4040.     addx.l    d1,d3
  4041.     move.l    d5,-(a0)
  4042.     move.l    d3,d0        ; nouvelle retenue d0
  4043.     dbra    d6,7$
  4044.     bfffo    d0{0:32},d1    ; d1.l contient nb. de shifts
  4045.     lsl.l    d1,d0        ; normalisation de d0
  4046.     moveq    #1,d6
  4047.     lsl.l    d1,d6
  4048.     subq.l    #1,d6        ; masque de shift
  4049.     neg.b    d1
  4050.     add.b    #32,d1
  4051.                 ; boucle de shift
  4052. 8$      move.l    (a0),d2
  4053.     ror.l    d1,d2
  4054.     move.l    d2,d3
  4055.     and.l    d6,d3
  4056.     sub.l    d3,d2
  4057.     add.l    d3,d0
  4058.     move.l    d0,(a0)+
  4059.     move.l    d2,d0
  4060.     dbra    d4,8$
  4061.     move.l    -4(a6),a0    ; a0 pointe sur resultat
  4062.     move.l    -4(a1),d0
  4063.     and.l    #$ffffff,d0    ; d0.l contient fexp1
  4064.     add.l    d1,d0        ; d0.l contient fexp resultat
  4065.     btst    #24,d0
  4066.     beq.s     9$
  4067.                 ; ici debordement
  4068. 11$     move.l    #muler2,-(sp)
  4069.     jsr     _err
  4070. 9$      move.w    d0,6(a0)    ; mise exposant
  4071.     swap    d0
  4072.     move.b    d0,5(a0)
  4073. mulsrf  move.l    -4(a6),d0    ; adresse du resultat
  4074. mulsrf1 movem.l    (sp)+,d2-d6/a2
  4075.     unlk    a6
  4076.     rts
  4077.     
  4078. *===================================================================*
  4079. *                                    *
  4080. *        Multiplication : entier * entier = entier        *
  4081. *                                    *
  4082. *    entree : a7($4) pointe sur i2 de type I             *
  4083. *         a7($8) pointe sur i1 de type I             *
  4084. *    sortie : d0 pointe sur i2 * i1 de type I (zone creee)    *
  4085. *                                    *
  4086. *===================================================================*
  4087.  
  4088. _mulii  link    a6,#0
  4089.     movem.l    d2-d7/a2-a4,-(sp)
  4090.     move.l    8(a6),a1
  4091.     move.l    12(a6),a2    ; a1,a2 pointent sur i1,i2
  4092.     move.w    6(a1),d1    
  4093.     move.w    6(a2),d2    ; d1.w, d2.w contient l1,l2
  4094.     cmp.w    d1,d2
  4095.     bcc.s     1$
  4096.                 ; ici l1>l2 : echanger i1 et i2
  4097.     exg     a1,a2
  4098.     exg     d1,d2        ; maintenant l1<=l2
  4099. 1$      subq.w    #2,d1        ; d1 recoit L1
  4100.     bne.s     2$
  4101.                 ; ici L1=0    <==> i1*i2 = 0
  4102. 6$      move.w    #2,d0
  4103.     bsr     _geti
  4104.     move.l    #2,4(a0)    ; cree resultat nul de type I
  4105.     bra     muliif
  4106.                 ; maintenant 1<=L1<=L2
  4107. 2$      move.w    d2,d0        ; d0 recoit l2
  4108.     add.w    d1,d0        ; d0 recoit l2 + L1 = L1 + L2 + 2
  4109.     bvc.s     3$
  4110.     move.l    #muler1,-(sp)
  4111.     jsr     _err        ; debordement
  4112.     bra.s     6$
  4113. 3$      bsr     _geti        ; allocation memoire pour resultat
  4114.     move.w    d0,6(a0)    ; met long effect. (peutetre 1 de trop)
  4115.     move.b    4(a1),d3
  4116.     move.b    4(a2),d4
  4117.     eor.b    d4,d3
  4118.     addq.b    #1,d3
  4119.     move.b    d3,4(a0)    ; met signe du resultat
  4120.     lea     0(a0,d0.w*4),a4 ; a4 pointe apres fin resultat = z
  4121.     lea     8(a1,d1.w*4),a1 ; a1 pointe apres fin de i1 = y
  4122.     lea     0(a2,d2.w*4),a3 ; a3 pointe apres fin de i2 = x
  4123.     subq.w    #1,d1        ; d1 recoit L1-1 compt bcl externe
  4124.     subq.w    #3,d2        ; d2 recoit L2-1 compt bcl interne
  4125.     move.w    d2,d0        ; sauvegarde compt interne dans d0
  4126.     moveq    #0,d7        ; registre d7 fixe a 0
  4127.                 ; Boucles de multiplication I*I :
  4128. ; x=x1x2...xn multiplicande (x=i2,n=L2) pointe par a2 et a3
  4129. ; y=y1...ym multiplicateur (y=i1,m=L1) pointe par a1
  4130. ; z=z1z2...z(n+m) resultat pointe par a0 et a4
  4131. ; a0 et a2 sont decrementes par la boucle interne (les valeurs initiales
  4132. ; etant conservees dans a4 et a3)
  4133. *...................................................................*
  4134.                 ; 1re boucle interne:initialise resultat
  4135.                 ; (z recoit x*ym)
  4136.     move.l    a3,a2        ; a2 pointe apres xn
  4137.     move.l    a4,a0        ; a0 pointe apres z(n+m)
  4138.     move.l    -(a1),d3     ; d3 recoit ym
  4139.     sub.l    d4,d4        ; d4 registre retenue k et X initialise a 0
  4140. m1    move.l    d4,d6        ; nouvelle retenue
  4141.     move.l    d3,d5        ; dupliquer multiplicateur
  4142.     mulu.l    -(a2),d4:d5    ; d4:d5 recoit x1*ym
  4143.     addx.l    d5,d6
  4144.     addx.l    d7,d4        ; d4:d6 recoit xi*ym + k
  4145.     move.l    d6,-(a0)     ; range z(i+m)
  4146.     dbra    d2,m1        
  4147.     bra.s     bclf        ; brancher fin de boucle externe
  4148. mext     subq.l    #4,a4        ; a4 pointe apres z(n+i)
  4149.     move.l    a3,a2        ; a2 pointe apres xn
  4150.     move.l    a4,a0        ; a0 pointe apres z(n+i)
  4151.     move.l    d0,d2        ; d2 recoit n-1 compteur bcl interne
  4152.     move.l    -(a1),d3     ; d3 recoit yj (j=m-1,m-2...1)
  4153.     sub.l    d4,d4        ; d4 recoit retenue initiale k et X=0
  4154. mint      move.l    d4,d6        ; sauver nouvelle retenue
  4155.     move.l    d3,d5        ; dupliquer multiplicateur
  4156.     mulu.l    -(a2),d4:d5    ; d4:d5 recoit xi*yj
  4157.     addx.l    d5,d6
  4158.     addx.l    d7,d4        ; d4:d5 recoit xi*yj + k
  4159.     add.l    d6,-(a0)     ; ranger partie basse de xi*yj+z(i+j)+k
  4160.     dbra    d2,mint        ; fin de boucle interne
  4161.     addx.l    d7,d4
  4162. bclf     move.l    d4,-(a0)     ; range derniere retenue
  4163.     dbra    d1,mext     ; fin bcl externe
  4164. *...................................................................*
  4165.                 ; derniere retenue = 0 ?
  4166.     beq.s     4$
  4167.     subq.l    #8,a0        ; non : rien a faire
  4168.                 ; a0 pointe sur resultat
  4169.     bra.s     muliif
  4170.                 ; ici pas de retenue finale
  4171. 4$      subq.w    #1,-2(a0)
  4172.     subq.w    #1,-6(a0)    ; rectifier longueurs
  4173.     move.l    -4(a0),(a0)     ; deplacer mots codes
  4174.     move.l    -8(a0),-(a0)    ; a0 pointe sur resultat
  4175.     add.l    #4,_avma
  4176. muliif  move.l    a0,d0
  4177.     movem.l    (sp)+,d2-d7/a2-a4
  4178.     unlk    a6
  4179.     rts
  4180.  
  4181. *===================================================================*
  4182. *                                    *
  4183. *        Multiplication : reel * reel = reel         *
  4184. *                                    *
  4185. *    entree : a7($4) pointe sur r2 de type R             *
  4186. *         a7($8) pointe sur r1 de type R             *
  4187. *    sortie : d0 pointe sur r2 * r1 de type R (zone creee)    *
  4188. *                                    *
  4189. *    precision : L = inf ( L1 , L2 )                 *
  4190. *                                    *
  4191. *===================================================================*
  4192.  
  4193. _mulrr  link    a6,#-20        ; variables locales pour murr aussi
  4194.     movem.l    d2-d7/a2-a4,-(sp)
  4195.     move.l    8(a6),a1    ; a1 pointe sur r1
  4196.     move.l    12(a6),a2    ; a2 pointe sur r2
  4197.     move.b    4(a1),d0
  4198.     and.b    4(a2),d0
  4199.     bne.s     munzr
  4200.                 ; ici r1 ou r2 = 0
  4201. muzr     moveq    #3,d0
  4202.     bsr     _getr
  4203.     move.l    a0,-8(a6)
  4204.     move.l    4(a1),d1    
  4205.     and.l    #$ffffff,d1    ; exposant de x1
  4206.     move.l    4(a2),d2    
  4207.     and.l    #$ffffff,d2    ; exposant de y
  4208.     add.l    d2,d1
  4209.     sub.l    #$800000,d1
  4210.     cmp.l    #$1000000,d1
  4211.     bcs.s     1$
  4212.     move.l    #muler4,-(sp)    ; debordement r*r
  4213.     jsr     _err
  4214. 1$      tst.l    d1
  4215.     bgt.s     2$
  4216.     move.l    #muler5,-(sp)    ; underflow r*r
  4217.     jsr     _err
  4218. 2$      move.l    d1,4(a0)
  4219.     clr.l    8(a0)
  4220.     bra.s     mulrrf
  4221. munzr   move.w  2(a2),d0
  4222.     clr.l    -12(a6)        ; Initialiser flag a 0
  4223.         cmp.w   2(a1),d0
  4224.         bls.s   1$
  4225.         move.w  2(a1),d0    ; d0.w contient L+2=inf(L1,L2)+2
  4226.         exg     a1,a2           ; a2 pointe sur le + court
  4227.     bra.s    2$
  4228. 1$    bne.s    2$
  4229.         lea     0(a1,d0.w*4),a3 ; a3 pointe sur x[L+1]
  4230.     move.l    a3,-12(a6)    ; longueurs egales: flag egal adresse
  4231.     move.l    (a3),-16(a6)    ; sauvegarde de x[L+1]
  4232.     clr.l    (a3)
  4233. 2$      bsr     getr
  4234.         move.l  a0,-8(a6)
  4235.         bsr.s   murr            ; effectuer la multiplication
  4236.     tst.l    -12(a6)
  4237.     beq.s    mulrrf
  4238.     move.l    -12(a6),a3
  4239.     move.l    -16(a6),(a3)    ; remettre x[L+1]
  4240. mulrrf  move.l    -8(a6),d0    ; adresse du resultat
  4241.     movem.l    (sp)+,d2-d7/a2-a4
  4242.     unlk    a6
  4243.     rts
  4244.  
  4245. *-------------------------------------------------------------------*
  4246. *    module interne de multiplication r0=r1*r2            *
  4247. *        ( pour R*R et I*R)                    *
  4248. *    entree : a1 et a2 pointent sur 2 reels            *
  4249. *    r1,r2  non nuls avec L1>=L2=m                *
  4250. *         a0 pointe sur une zone reelle de long l1        *
  4251. *    sortie : le produit r0 est mis a l'addresse a0              *
  4252. *                                    *
  4253. *-------------------------------------------------------------------*
  4254.  
  4255. ; notation : r1 = x = x1x2...xmx(m+1)...  multiplicande
  4256. ;         r2 = y = y1y2...ym       multiplicateur
  4257. ;    ( le lgmot x(m+1) peut ne pas exister ! ( le1 >= le2 = m ) )
  4258. ;          z = z0z1z2...zmz(m+1) resultat.
  4259. ;    ( z0=0 ou 1 et z(m+1) a jeter)
  4260. ;    move.w  2(a2),d0 doit avoir ete fait avant.
  4261.  
  4262.  
  4263. murr     move.l    a1,a3
  4264.     lea     12(a3),a3    ; a3 pointe sur x2 (2me lgmot mant.x)
  4265.     lea     0(a2,d0.w*4),a2 ; a2 pointe apres ym
  4266.     lea     0(a0,d0.w*4),a0 ; a0 pointe apres zm
  4267.     move.l    (a0),-4(a6)     ; on sauvegarde le lg mot suivant z
  4268.     clr.l    (a0)+        ; z(m+1) recoit 0,a0 pointe apres z(m+1)
  4269.     subq.w    #3,d0        ; d0 recoit m-1 
  4270.     move.l    d0,-20(a6)    ; sauvegarde m-1 compt. bcl externe
  4271.     clr.w    d3        ; d3=0,val initiale compt bcl interne
  4272.                 ; Boucles triangulaires mult. R*R
  4273. *...................................................................*
  4274. bext     move.l    a0,a4        ; a4 pointe apres z(m+1)
  4275.     move.l    a3,a1        ; a1 pointe sur x(j+1) (j=1,2...m)
  4276.     move.w    d3,d2        ; d3 recoit m-j compt bcl interne
  4277.     move.l    -(a2),d4     ; d4 recoit yj
  4278.     move.l    (a3)+,d5     ; d5 recoit x(j+1)
  4279.     sub.l    d1,d1        ; d1 et X a zero
  4280.     mulu.l    d4,d7:d5    ; init.retenue d7(ignorer poids faible)
  4281. bint     move.l    d7,d6        ; sauver retenue
  4282.     move.l    d4,d5        ; dupliquer multiplicateur
  4283.     mulu.l    -(a1),d7:d5    ; d7:d5 recoit xi*yj
  4284.     addx.l    d5,d6
  4285.     addx.l    d1,d7        ; d7:d6 recoit xi*yj + k
  4286.     add.l    d6,-(a4)     ; nouveau z(i+j)
  4287.     dbra    d2,bint
  4288.     addx.l    d1,d7
  4289.     move.l    d7,-(a4)     ; range derniere retenue
  4290.     addq.w    #1,d3        ; augmente de 1 long bcl interne
  4291.     dbra    d0,bext     ; fin bcl externe
  4292. *...................................................................*
  4293.     move.l    -4(a1),d1    ; a1 pointe sur x1 (1er mot mant de x)
  4294.     and.l    #$ffffff,d1    ; exposant de x1
  4295.     move.l    -4(a2),d2    ; a2 pointe sur y1
  4296.     and.l    #$ffffff,d2    ; exposant de y
  4297.     add.l    d2,d1
  4298.     sub.l    #$800000,d1
  4299.     tst.l    (a4)         ; a4 pointe sur z1 : z normalise ?
  4300.     bpl.s     1$
  4301.     add.l    #1,d1        ; ici mantisse normalisee
  4302.     bra.s     2$
  4303.                 ; ici il faut shifter de 1 a gauche
  4304. 1$      move.l    a0,a4        ; a4 pointe apres z(m+1)
  4305.     subq.w    #2,a4
  4306.     move.l    -20(a6),d0    ; recuperer compteur m-1
  4307.     roxl.w    -(a4)        ; initialise le carry
  4308. 5$      roxl.w    -(a4)        ; shift par mots (d0 compteur=m-1)
  4309.     roxl.w    -(a4)
  4310.     dbra    d0,5$        ; boucle de shift
  4311. 2$      cmp.l    #$1000000,d1
  4312.     bcs.s     3$
  4313.     move.l    #muler4,-(sp)    ; debordement r*r
  4314.     jsr     _err
  4315. 3$      tst.l    d1
  4316.     bgt.s     4$
  4317.     move.l    #muler5,-(sp)    ; underflow r*r
  4318.     jsr     _err
  4319. 4$      move.l    d1,-(a4)     ; range exposant
  4320.     move.b    -4(a1),d1
  4321.     move.b    -4(a2),d2    ; signes
  4322.     eor.b    d2,d1
  4323.     addq.b    #1,d1
  4324.     move.b    d1,(a4)        ; range signe resultat
  4325.     move.l    -4(a6),-4(a0) ; remet en place mot sous z(m+1)
  4326. murrf     rts
  4327.  
  4328. *===================================================================*
  4329. *                                    *
  4330. *        Multiplication : entier * reel = reel        *
  4331. *                                    *
  4332. *    entree : a7($4) pointe sur i2 de type I             *
  4333. *         a7($8) pointe sur r1 de type R             *
  4334. *    sortie : d0 pointeur sur i2 * r1 de type R (zone creee)     *
  4335. *                                    *
  4336. *===================================================================*
  4337.  
  4338. _mulir  link    a6,#-20
  4339.     movem.l    d2-d7/a2-a4,-(sp)
  4340.     move.l    8(a6),a2    ; a2 pointe sur i2
  4341.     tst.b    4(a2)
  4342.     bne.s     1$
  4343.                 ; ici i2 = 0
  4344.     move.w    #2,d0
  4345.     bsr     _geti
  4346.     move.l    #2,4(a0)
  4347.     move.l    a0,d0
  4348.     bra.s     mulirf1
  4349.                 ; ici i2 <> 0
  4350. 1$      move.l    12(a6),a1    ; a1 pointe sur r1
  4351.     tst.b    4(a1)
  4352.     bne.s     2$
  4353.                 ; ici r1 = 0
  4354.     moveq    #3,d0
  4355.     bsr     _getr
  4356.     move.w    6(a2),d0
  4357.     lsl.l    #5,d0
  4358.     bfffo    8(a2){0:32},d1
  4359.     sub.l    d1,d0
  4360.     sub.l    #65,d0
  4361.     add.l    4(a1),d0
  4362.     cmp.l    #$1000000,d0
  4363.     bcs.s     3$
  4364.     move.l    #muler6,-(sp)    ; overflow I*R, R = 0
  4365.     jsr     _err
  4366. 3$      move.l    d0,4(a0)
  4367.     clr.l    8(a0)
  4368.     move.l    a0,d0
  4369.     bra.s     mulirf1
  4370.                 ; ici i2 <> 0 et r1<> 0
  4371. 2$      move.w    2(a1),d0
  4372.     bsr     _getr        ; allocation memoire pour resultat
  4373.     move.l    a0,-8(a6)    ; sauvegarde adresse resultat
  4374.     move.w    2(a1),d0
  4375.     bsr     _getr        ; allocation mem pour conversion i2->r2
  4376.     move.l    a0,-(a7)
  4377.     move.l    a2,-(a7)
  4378.     bsr     _affir
  4379.     addq.l    #4,sp
  4380.     move.l    (a7),a2        ; a2 recoit adr de r2=i2 (reste en pile)
  4381.     move.l    -8(a6),a0    ; a0 recoit addresse du resultat
  4382.     exg    a1,a2        ; Il faut que a2 soit le plus court!
  4383.     move.w    2(a2),d0    ; Mettre l'inf des longueurs dans d0 pour murr
  4384.     bsr     murr
  4385.     move.l    (a7)+,a0
  4386.     bsr     _giv
  4387. mulirf  move.l    -8(a6),d0
  4388. mulirf1 movem.l    (sp)+,d2-d7/a2-a4
  4389.     unlk    a6
  4390.     rts
  4391.  
  4392.  
  4393.  
  4394.  
  4395.  
  4396. *********************************************************************
  4397. *********************************************************************
  4398. ***                                   ***
  4399. ***         PROGRAMMES DE DIVISION AVEC RESTE          ***
  4400. ***                                   ***
  4401. *********************************************************************
  4402. *********************************************************************
  4403.  
  4404.  
  4405.  
  4406.  
  4407.  
  4408. *===================================================================*
  4409. *                                    *
  4410. *        Division avec reste (par valeur)            *
  4411. *                                    *
  4412. *    entree : a7($4) pointe sur n2 de type I             *
  4413. *         a7($8) pointe sur n1 de type I             *
  4414. *         a7($12) pointe sur n3 de type I            *
  4415. *         a7($16) pointe sur n4 de type I            *
  4416. *    sortie : la zone pointee par a7($12) contient n2 / n1    *
  4417. *         la zone pointee par a7($16) contient le reste (du    *
  4418. *         signe du dividende)                *
  4419. *    interdit : type S et R                    *
  4420. *                                    *
  4421. *===================================================================*
  4422.  
  4423. _mpdvmdz lea    _dvmdii,a0
  4424.     bra     mpopii
  4425.  
  4426.                 ; division avec reste S/S=(I et I)
  4427.                 ; sinon erreur
  4428.  
  4429. _dvmdssz lea    _dvmdss,a0
  4430.     bra     mpopii
  4431.  
  4432.                 ; division avec reste S/I=(I et I)
  4433.                 ; sinon erreur
  4434.  
  4435. _dvmdsiz lea    _dvmdsi,a0
  4436.     bra     mpopii
  4437.  
  4438.                 ; division avec reste I/S=(I et I)
  4439.                 ; sinon erreur
  4440.  
  4441. _dvmdisz lea    _dvmdis,a0
  4442.     bra     mpopii
  4443.  
  4444.                 ; division avec reste I/I=(I et I)
  4445.                 ; sinon erreur
  4446.  
  4447. _dvmdiiz lea    _dvmdii,a0
  4448.     bra     mpopii
  4449.  
  4450. *===================================================================*
  4451. *                                    *
  4452. *Division avec reste : entier court / entier court =(entier,entier) *
  4453. *                                    *
  4454. *    entree : a7($4) contient s2 de type S            *
  4455. *         a7($8) contient s1 de type S            *
  4456. *    sortie : a7($12) pointe sur l'adresse du futur reste        *
  4457. *         d0 pointe sur s2 div s1 de type I            *
  4458. *         le reste est du signe de s2 (zone creee)        *
  4459. *                                    *
  4460. *===================================================================*
  4461.  
  4462. _dvmdss link    a6,#0
  4463.     move.l    d2,-(sp)
  4464.     move.l    12(a6),-(sp)    ; empilage s1
  4465.     move.l    8(a6),-(sp)     ; empilage s2
  4466.     bsr     _divss
  4467. dmd     addq.l    #8,sp
  4468.     tst.l    d1
  4469.     bne.s     1$
  4470.                 ; ici reste nul
  4471.     move.l    d0,d1
  4472.     moveq    #2,d0
  4473.     bsr     _geti
  4474.     move.l    #2,4(a0)
  4475.     move.l    d1,d0
  4476.     bra.s     dvmdssf
  4477.                 ; ici reste non nul
  4478. 1$      move.l    d0,d2
  4479.     moveq    #3,d0
  4480.     bsr     _geti
  4481.     move.l    #$1000003,4(a0)
  4482.     tst.l    d1
  4483.     bpl.s     2$
  4484.     neg.l    d1
  4485.     move.b    #-1,4(a0)
  4486. 2$      move.l    d1,8(a0)
  4487.     move.l    d2,d0
  4488. dvmdssf move.l    16(a6),a1
  4489.     move.l    a0,(a1)
  4490.     move.l    (sp),d2
  4491.     unlk    a6
  4492.     rts
  4493.  
  4494. *===================================================================*
  4495. *                                    *
  4496. *    Division avec reste : entier court / entier = (entier,entier)    *
  4497. *                                    *
  4498. *    entree : a7($4) contient s2 de type S            *
  4499. *         a7($8) pointe sur i1 de type I             *
  4500. *         a7($12) pointe sur l'adresse du futur reste        *
  4501. *    sortie : d0 pointe sur s2 div i1 de type I ;        *
  4502. *         reste du signe de s2 (zones creees)        *
  4503. *                                    *
  4504. *===================================================================*
  4505.  
  4506. _dvmdsi move.l    8(a7),-(sp)
  4507.     move.l    8(a7),-(sp)
  4508.     bsr     _divsi
  4509. dmdi     addq.l    #8,sp
  4510.     move.l    d0,a1        ; sauvegarde adresse quotient
  4511.     tst.l    d1
  4512.     bne.s     1$
  4513.                 ; ici reste nul
  4514.     moveq    #2,d0
  4515.     bsr     _geti
  4516.     move.l    #2,4(a0)
  4517.     bra.s     3$
  4518.                 ; ici reste non nul
  4519. 1$      moveq    #3,d0
  4520.     bsr     _geti
  4521.     move.l    #$1000003,4(a0)
  4522.     tst.l    d1
  4523.     bpl.s     2$
  4524.     neg.l    d1
  4525.     move.b    #-1,4(a0)
  4526. 2$      move.l    d1,8(a0)
  4527. 3$      move.l    a1,d0
  4528.     move.l    a0,([12,sp])
  4529.     rts
  4530.  
  4531. *===================================================================*
  4532. *                                    *
  4533. *    Division avec reste : entier / entier court = (entier,entier)    *
  4534. *                                    *
  4535. *    entree : a7($4) pointe sur i2 de type I             *
  4536. *         a7($8) contient s1 de type S            *
  4537. *         a7($12) pointe sur l'adresse du futur reste        *
  4538. *    sortie : d0 pointe sur i2 div s1 de type I            *
  4539. *         reste de type I du signe de s1 (zones creees)    *
  4540. *                                    *
  4541. *===================================================================*
  4542.  
  4543. _dvmdis move.l    8(a7),-(sp)
  4544.     move.l    8(a7),-(sp)
  4545.     bsr     _divis
  4546.     bra.s     dmdi
  4547.  
  4548. *===================================================================*
  4549. *                                    *
  4550. *    Division avec reste : entier / entier = (entier,entier)     *
  4551. *                                    *
  4552. *    entree : a7($4) pointe sur i2 de type I (dividende)     *
  4553. *         a7($8) pointe sur i1 de type I (diviseur)        *
  4554. *         a7($12) contient un pointeur sur le reste si l'on  *
  4555. *         veut a la fois q et r, 0 si l'on ne veut que le    *
  4556. *         quotient, -1 si l'on ne veut que le reste          *
  4557. *    sortie : d0 pointe sur q si celui-ci est attendu, et sinon    *
  4558. *         sur r. a7($12) pointe sur r si q et r sont attendus*
  4559. *         (toutes les zones sont creees)             *
  4560. *    remarque : il s'agit de la 'fausse division' ; le reste est *
  4561. *          du signe du dividende                 *
  4562. *                                    *
  4563. *                                    *
  4564. *    variables locales (etat pile apres link):            *
  4565. *  -16 -14 -12 -10 -8  -6    -4      a6    4     8      12   16        *
  4566. *  +---+---+---+---+---+---+------+----+----+----+----+----+    *
  4567. *    n-m  k sgnq sgnr n     m    ad(q,r)      ret  i2   i1 ^r/0/-1    *
  4568. *                                    *
  4569. *===================================================================*
  4570.  
  4571. _dvmdii link    a6,#-32
  4572.     movem.l    d2-d7/a2-a4,-(sp)
  4573.     move.l    12(a6),a1    ; a1 pointe sur le diviseur i1
  4574.     move.w    6(a1),d1    ; d1.w contient le1
  4575.     cmp.w    #2,d1
  4576.     bne.s     dv1
  4577.                 ; ici i1 = 0
  4578.     move.l    #dvmer1,-(sp)
  4579. dvmerr  jsr     _err
  4580.                 ; ici i1 <> 0
  4581. dv1     move.l    8(a6),a2    ; a2 pointe sur dividende i2
  4582.     move.w    6(a2),d2    ; d2.w contient le2
  4583.     cmp.w    #2,d2
  4584.     bne.s     dv3
  4585.                 ; ici quotient=reste=0
  4586. dv2     move.l    16(a6),d3
  4587.     cmp.l    #-1,d3
  4588.     beq.s     1$
  4589.                 ; ici quotient attendu (q=0)
  4590.     moveq    #2,d0
  4591.     bsr     _geti
  4592.     move.l    #2,4(a0)
  4593.     move.l    a0,d0
  4594. 1$      tst.l    d3
  4595.     beq     dvmiif
  4596.                 ; ici reste attendu (r=0)
  4597.     move.l    d0,d1
  4598.     moveq    #2,d0
  4599.     bsr     _geti
  4600.     move.l    #2,4(a0)
  4601.     btst    #0,d3        ; test si fonction mod
  4602.     bne.s     2$
  4603.     move.l    d3,a1        ; d3 pointe sur l'adr. du reste
  4604.     move.l    a0,(a1)
  4605.     move.l    d1,d0
  4606.     bra     dvmiif
  4607. 2$      move.l    a0,d0
  4608.     bra     dvmiif
  4609.                 ; ici i2 et i1 <> 0
  4610. dv3     move.w    d2,d0        ; le2
  4611.     sub.w    d1,d0        ; d0.w contient L2-L1
  4612.     bcc.s     dv4
  4613.                 ; ici q=0 , r=i2
  4614.     move.l    16(a6),d3
  4615.     cmp.l    #-1,d3
  4616.     beq.s     1$
  4617.                 ; quotient attendu soit q=0
  4618.     moveq    #2,d0
  4619.     bsr     _geti
  4620.     move.l    a0,d0
  4621.     move.l    #2,4(a0)
  4622. 1$      tst.l    d3
  4623.     beq     dvmiif
  4624.                 ; reste attendu soit r=i1
  4625.     move.l    d0,d1
  4626.     move.w    d2,d0
  4627.     bsr     _geti
  4628.     move.l    a0,a1
  4629.     subq.w    #2,d0
  4630.     addq.l    #4,a0
  4631.     addq.l    #4,a2
  4632. 2$      move.l    (a2)+,(a0)+
  4633.     dbra    d0,2$
  4634.     cmp.l    #-1,d3
  4635.     beq.s     3$
  4636.     move.l    d3,a0
  4637.     move.l    a1,(a0)
  4638.     move.l    d1,d0
  4639.     bra     dvmiif
  4640. 3$      move.l    a1,d0
  4641.     bra     dvmiif
  4642.                 ; ici L2 >= L1
  4643. dv4     move.b    4(a1),d3    ; d3.b contient signe de i1
  4644.     move.b    4(a2),d4    ; d4.b contient signe de i2
  4645.     eor.b    d4,d3
  4646.     addq.b    #1,d3        ; d4.b contient signe de q
  4647.     move.b    d3,-12(a6)     ; sauvegarde signe de q
  4648.     move.b    d4,-10(a6)     ; sauvegarde signe de r
  4649.     move.l    _avma,-20(a6)    ; sauvegarde __avma initial
  4650.     move.w    d2,d0        ; d0 recoit l2
  4651.     bsr     _geti        ; allocation memoire de travail :
  4652.                 ; on va y former q0q1...q(n-m)r1r2...rm
  4653.                 ; les memoires provisoires ne seront pas
  4654.                 ; rendues par giv:on ecrase mot code
  4655.     move.l    a0,-4(a6)    ; sauvegarde addresse zone de travail
  4656.     subq.w    #2,d1
  4657.     subq.w    #2,d2
  4658.     move.w    d1,-6(a6)    ; sauvegarde L1 (=m)
  4659.     move.w    d2,-8(a6)    ; sauvegarde L2 (=n)
  4660.     move.w    d2,-16(a6)
  4661.     sub.w    d1,-16(a6)     ; n-m dans a6($-16)
  4662.     addq.l    #8,a2
  4663.     addq.l    #8,a1
  4664.     move.l    (a1),d3        ; d3.l=y1 (1er lgmot du diviseur i1)
  4665.     subq.w    #1,d2        ; d2 recoit n-1
  4666.     subq.w    #1,d1        ; d1 recoit m-1
  4667.     bne.s     divlon
  4668.                 ; ici division simple (m = 1)
  4669. divsim  clr.l    d4
  4670. 1$      move.l    (a2)+,d5
  4671.     divu.l    d3,d4:d5
  4672.     move.l    d5,(a0)+
  4673.     dbra    d2,1$
  4674.     move.l    d4,(a0)        ; reste mis derriere quotient
  4675.     move.l    a0,a2        ; a2 pointe sur reste
  4676.     clr.w    -14(a6)    ; on n'a pas fait de shift
  4677.     bra     ranger
  4678.                 ; ici division longue (m > 1)
  4679. divlon  bfffo    d3{0:32},d4    ; d4 recoit nb de shift pour normaliser
  4680.     move.w    d4,-14(a6)     ; sauvegarde du nb. de shifts = k
  4681.     bne.s     1$
  4682.                 ; ici pas de normalisation
  4683.     move.l    a0,a4
  4684.     move.l    #0,(a4)+     ; met a 0 1er lgmot soit x0
  4685. 4$      move.l    (a2)+,(a4)+    ; recopie x1x2...xn
  4686.     dbra    d2,4$
  4687.     move.l    a0,a2        ; a2 pointe sur x0,a4 pointe apres xn
  4688.     lea     4(a1,d1.w*4),a3 ; a1 pointe sur y1,a3 pointe apres ym
  4689.     bra.s     nosh
  4690.                 ; ici on normalise le diviseur i1=y
  4691.                 ; et on decale autant le dividende:
  4692. 1$      lsl.l    d4,d3        ; normalisation de y1
  4693.     move.w    -6(a6),d0    ; on demande m lgmots
  4694.     bsr     _geti        ; allocation pour copie normalisee de y
  4695.     moveq    #1,d6
  4696.     lsl.l    d4,d6
  4697.     subq.l    #1,d6        ; masque de shift
  4698.     move.l    a0,a3
  4699.     subq.w    #1,d0        ; d0 compt. mis a m-1
  4700.     addq.l    #4,a1        ; a1 pointe sur y2 2me lg mot diviseur
  4701.     bra.s     3$
  4702. 2$      move.l    (a1)+,d1     ; boucle shift vers la gauche ds copie
  4703.     rol.l    d4,d1
  4704.     move.l    d1,d5
  4705.     and.l    d6,d1
  4706.     add.l    d1,d3
  4707.     move.l    d3,(a3)+
  4708.     sub.l    d1,d5
  4709.     move.l    d5,d3
  4710. 3$      dbra    d0,2$
  4711.     move.l    d3,(a3)+
  4712.     move.l    a0,a1        ; a1 pointe sur 1er lgmot y1 normalise
  4713.                 ; a3 pointe apres ym
  4714.                 ; transfert avec shift du dividende:
  4715.     move.l    -4(a6),a4    ; a4 pointe sur zone de travail
  4716.     moveq    #0,d3
  4717.     move.w    -8(a6),d0
  4718.     subq.w    #1,d0        ; d0 recoit n-1 compteur
  4719. 5$      move.l    (a2)+,d1     ; boucle de shift du dividende i2
  4720.     rol.l    d4,d1        ; sur place
  4721.     move.l    d1,d5        
  4722.     and.l    d6,d1
  4723.     add.l    d1,d3
  4724.     move.l    d3,(a4)+
  4725.     sub.l    d1,d5
  4726.     move.l    d5,d3
  4727.     dbra    d0,5$
  4728.     move.l    d3,(a4)
  4729.     move.l    -4(a6),a2    ; a2 pointe sur x0 ;(a4 pointe sur xn)
  4730. nosh     move.w    -6(a6),d6    ; d6 recoit m
  4731.     lea     4(a2,d6.w*4),a4 ; a4 pointe apres xm
  4732.     subq.w    #1,d6        ; d6 recoit m-1 compteur bcls internes
  4733.     move.w    -16(a6),d7     ; d7 recoit n-m compteur bcl externe
  4734. *-------------------------------------------------------------------*
  4735.                 ; boucles de division I / I :
  4736.     ; a1 pointe sur y1, a3 pointe apres ym : diviseur y1y2...ym
  4737.     ; a2 pointe sur x0, a4 pointe apres xm : dividende x0x1...xn
  4738.     ; d7 contient n-m compt. boucle externe
  4739.     ; d6 contient m compt. boucles internes (n>=m>=2)
  4740.     ; la zone x0x1...xn recoit q0q1...q(n-m)r1r2...rm
  4741.  
  4742. bclext  move.l    (a1),d0        ; d0 recoit y1 (1er lgmot diviseur)
  4743.     cmp.l    (a2),d0        ; xi = y1 ? (i=0,1...n)
  4744.     bne.s     1$
  4745.     moveq    #-1,d1        ; oui: essayer q=2^32-1
  4746.     add.l    4(a2),d0    ; calcul du reste
  4747.                 ; r=xix(i+1) mod y1 = xi+x(i+1)
  4748.     bcs.s     4$        ; si r>=2^32 , q est ok
  4749.     move.l    d0,d2        ; sinon d2 recoit r
  4750.     bra.s 2$            ; rejoindre cas general
  4751. 1$      move.l    (a2),d2        ; si xi<y1 :
  4752.     move.l    4(a2),d1    ; d2:d1 recoit xix(i+1)
  4753.     divu.l    d0,d2:d1    ; d1 recoit q = xix(i+1) div y1
  4754.                 ; d2 recoit r = xix(i+1) mod y1
  4755. 2$      move.l    4(a1),d3    ; d3 recoit y2
  4756.     mulu.l    d1,d4:d3    ; d4:d3 recoit q*y2
  4757.     sub.l    8(a2),d3
  4758.     subx.l    d2,d4        ; d4:d3 recoit q*y2-(r,x(i+2))
  4759.     bls.s     4$        ; si <= 0 alors q ok
  4760. 3$      subq.l    #1,d1        ; sinon diminuer q
  4761.     sub.l    4(a1),d3    ; corriger reste partiel:
  4762.     subx.l    d0,d4        ; d3:d4 recoit d3:d4-y1y2
  4763.     bhi.s     3$        ; tant que q*y1y2>xix(i+1)x(i+2)
  4764.                 ; recommencer q recoit q-1
  4765.                 ; ici q*y1y2 <= xix(i+1)x(i+2)
  4766.                 ; on va former le nouveau reste
  4767.                 ; en remplacant x(i+1)...x(i+m) par
  4768.                 ; x(i+1)...x(i+m) - q*y1...ym
  4769. 4$      move.w    d6,d0        ; d0 recoit m-1 compteur
  4770.     move.l    a3,a1        ; a1 pointe apres ym
  4771.     move.l    a4,a2        ; a2 pointe apres x(i+m)
  4772.     moveq    #0,d2        ; d2 fixe a 0 pour les addxl
  4773.     sub.l    d3,d3        ; d3 recoit k retenue initialisee a 0 et X=0
  4774. 5$      move.l    -(a1),d5     ; d5 recoit x(i+j) j=m,m-1,...,1
  4775.     mulu.l    d1,d4:d5
  4776.     addx.l    d3,d5
  4777.     addx.l    d2,d4
  4778.     sub.l    d5,-(a2)     ; nouvel x(i+j)
  4779.     move.l    d4,d3
  4780.     dbra    d0,5$
  4781.     addx.l    d2,d3
  4782.     sub.l    d3,-4(a2)    ; soustrait derniere retenue
  4783.     bcc.s     6$        ; si pas carry q=qi est definitif
  4784.     subq.l    #1,d1        ; sinon encore 1 de trop
  4785.     move.w    d6,d0        ; repositionner compteur m-1
  4786.     move.l    a3,a1
  4787.     move.l    a4,a2        ; repositionner pointeurs
  4788. 7$      addx.l    -(a1),-(a2)
  4789.     dbra    d0,7$        ; boucle de remise a jour du reste
  4790.                 ; il y a forcement carry final a ignorer
  4791. 6$      move.l    d1,-4(a2)    ; qi est range sur l'ancien xi
  4792.     addq.l    #4,a4        ; a4 pointe apres x(i+m+1)
  4793.     dbra    d7,bclext    ; boucler pour q0q1...q(n-m)
  4794.                 ; fin des boucles de division I/I
  4795.                 ; a2 pointe apres q(n-m),ie sur r1
  4796. *-------------------------------------------------------------------*
  4797.                 ; rangement des resultats
  4798.  
  4799. ranger  clr.l    -28(a6)
  4800.     clr.l    -32(a6)
  4801.     move.l    _avma,-24(a6)    ; actuel __avma
  4802.     move.l    -20(a6),d7     ; __avma initial
  4803.     sub.l    _avma,d7    ; nb d'octets memoire provisoires
  4804.                 ; offset:ajouter aux addresses fournies
  4805.     move.l    16(a6),d3
  4806.     cmp.l    #-1,d3
  4807.     beq.s     rngres
  4808.                 ; ici quotient attendu
  4809.     move.l    -4(a6),a0    ; a0 pointe sur q0
  4810.     move.w    -16(a6),d0     ; d0 recoit n-m
  4811.     move.w    d0,d1
  4812.     addq.w    #2,d0
  4813.     tst.l    (a0)
  4814.     beq.s     1$
  4815.     addq.w    #1,d0
  4816. 1$      bsr     _geti        ; allocation memoire pour quotient
  4817.     move.l    a0,-28(a6)     ; a6($-28) recoit adr. provisoire de q
  4818.     add.l    d7,-28(a6)     ; ajoute offset memoires provisoires
  4819.                 ; a6($-28) contient adr definitive de q
  4820.     lea     0(a0,d0.w*4),a1
  4821.     move.l    a2,a3        ; a2 et a3 pointe sur r1
  4822. 2$      move.l    -(a3),-(a1)    ; recopie q0,q1...q(n-m)
  4823.     dbra    d1,2$
  4824.     move.w    d0,6(a0)    ; met long effective de q
  4825.     move.b    -12(a6),4(a0) ; met signe de q
  4826.     cmp.w    #2,d0
  4827.     bne.s     rngres
  4828.     clr.b    4(a0)        ; rectifier signe lorsque q=0
  4829. rngres  tst.l    d3
  4830.     beq     rendre
  4831.                 ; ici reste attendu
  4832.     move.w    -6(a6),d0
  4833.     subq.w    #1,d0        ; d0 recoit m-1
  4834. 4$      tst.l    (a2)+
  4835.     dbne    d0,4$        ; chasse les zeros
  4836.     bne.s     1$
  4837.                 ; ici r=0 : ranger 0
  4838.     move.w    #2,d0
  4839.     bsr     _geti
  4840.     move.l    #2,4(a0)
  4841.     add.l    d7,a0        ; ajoute offset
  4842.     move.l    a0,-32(a6)     ; adr. definit. de r
  4843.     bra.s     rendre
  4844. 1$      subq.l    #4,a2        ; a2 pointe sur 1er ri non nul
  4845.     move.w    d0,d1
  4846.     addq.w    #3,d0
  4847.     bsr     _geti        ; allocation memoire pour reste
  4848.     move.l    a0,-32(a6)
  4849.     add.l    d7,-32(a6)     ; ajoute offset memoires provisoires
  4850.     move.b    -10(a6),4(a0) ; met signe de r
  4851.     move.w    d0,6(a0)    ; met long effect provisoire (si shift)
  4852.     addq.l    #8,a0
  4853.     move.w    -14(a6),d3     ; d3 recoit k nb de shifts
  4854.     bne.s     2$
  4855.                 ; ici k=0 pas de shift
  4856. 5$      move.l    (a2)+,(a0)+
  4857.     dbra    d1,5$        ; recopie des ri effectifs
  4858.     bra.s     rendre
  4859. 2$      moveq    #-1,d6        ; ici shift de r
  4860.     lsr.l    d3,d6        ; d6 recoit masque de shift
  4861.     moveq    #0,d5
  4862.     bset    d3,d5        ; d5 recoit 2^k
  4863.     moveq    #0,d2
  4864.     cmp.l    (a2),d5        ; comparer 1er ri a 2^k
  4865.     bls.s     3$
  4866.     move.l    (a2)+,d2     ; ici ri < 2^k    : le shifter
  4867.     ror.l    d3,d2
  4868.     subq.w    #1,d0        ; et diminuer de 1 la long de la boucle
  4869.     subq.w    #1,-2(a0)    ; ainsi que la long effective de r
  4870. 3$      move.l    (a2)+,d5     ; boucle de shift de r
  4871.     ror.l    d3,d5        ; boucle jamais vide car r>=2^k
  4872.     move.l    d5,d4
  4873.     and.l    d6,d4
  4874.     add.l    d4,d2
  4875.     move.l    d2,(a0)+
  4876.     sub.l    d4,d5
  4877.     move.l    d5,d2
  4878.     dbra    d1,3$
  4879. rendre  move.l    -20(a6),a0     ; rendre memoires provisoires
  4880.     move.l    -24(a6),a1     ; il faut rendre la zone entre a1 et a0
  4881.     move.l    a1,d0
  4882.     sub.l    _avma,d0
  4883.     lsr.l    #2,d0        ; nb de lgmots a deplacer
  4884.     subq.w    #1,d0
  4885. 1$      move.l    -(a1),-(a0)
  4886.     dbra    d0,1$
  4887.     move.l    a0,_avma        ; nouvel __avma
  4888.     move.l    -28(a6),d0
  4889.     bne.s     2$
  4890.     move.l    -32(a6),d0
  4891.     bra.s     dvmiif
  4892. 2$      tst.l    -32(a6)
  4893.     beq.s     dvmiif
  4894.     move.l    16(a6),a1
  4895.     move.l    -32(a6),(a1)
  4896. dvmiif  movem.l    (sp)+,d2-d7/a2-a4
  4897.     unlk    a6
  4898.     rts
  4899.  
  4900.  
  4901.  
  4902. *===================================================================*
  4903. *                                    *
  4904. *            Divisibilite de i2 par i1            *
  4905. *                                    *
  4906. *    entree : a7($4) pointe sur n2 de type I             *
  4907. *         a7($8) pointe sur n1 de type I             *
  4908. *         a7($12) contient un pointeur ( pour quotient )     *
  4909. *    sortie : d0 contient 1 si n1 divise n2            *
  4910. *                 0 sinon
  4911. *    a7($12) pointe sur n2 / n1 de type I  (zone creee)        *
  4912. *    lorsque n1 divise n2,  sinon n'est pas affecte.             *
  4913. *                                    *
  4914. *===================================================================*
  4915.  
  4916. _mpdivis link a6,#-8
  4917.     move.l    _avma,-8(a6)
  4918.     pea     -4(a6)
  4919.     move.l    12(a6),-(sp)
  4920.     move.l    8(a6),-(sp)
  4921.     bsr     _dvmdii
  4922.     lea     12(sp),sp
  4923.     tst.b    ([-4,a6],4)         ; reste nul ?
  4924.     beq.s     1$
  4925.                     ; ici reste non nul
  4926.     moveq    #0,d0
  4927.     move.l    -8(a6),_avma        ; desallouer q et r
  4928.     bra.s     2$
  4929.                     ; ici reste nul
  4930. 1$      move.l    16(a6),-(sp)
  4931.     move.l    d0,-(sp)         ; adresse du quotient
  4932.     bsr     _affii
  4933.     moveq    #1,d0
  4934.     move.l    -8(a6),_avma            ; desallouer reste
  4935. 2$      unlk    a6
  4936.     rts
  4937.  
  4938.  
  4939. *===================================================================*
  4940. *                                    *
  4941. *        Flag de divisibilite de i2 par i1            *
  4942. *                                    *
  4943. *    entree : a7($4) pointe sur n2 de type I             *
  4944. *         a7($8) pointe sur n1 de type I             *
  4945. *    sortie : d0 contient 1 si n1 divise n2            *
  4946. *                 0 sinon                *
  4947. *                                    *
  4948. *===================================================================*
  4949.  
  4950. _divise  move.l    #-1,-(sp)
  4951.     move.l    12(sp),-(sp)
  4952.     move.l    12(sp),-(sp)
  4953.     bsr     _dvmdii
  4954.     lea     12(sp),sp
  4955.     move.l    d0,a0
  4956.     moveq    #1,d0
  4957.     tst.b    4(a0)            ; reste nul ?
  4958.     beq     _giv
  4959.                     ; ici reste non nul
  4960.     moveq    #0,d0
  4961.     bra     _giv
  4962.  
  4963.  
  4964.  
  4965.  
  4966. *********************************************************************
  4967. *********************************************************************
  4968. ***                                   ***
  4969. ***             PROGRAMMES DE DIVISION              ***
  4970. ***                                   ***
  4971. *********************************************************************
  4972. *********************************************************************
  4973.  
  4974.  
  4975.  
  4976.  
  4977.  
  4978. *===================================================================*
  4979. *                                    *
  4980. *            Division generale                *
  4981. *                                    *
  4982. *    entree : a7($4) pointe sur n2 de type I ou R        *
  4983. *         a7($8) pointe sur n1 de type I ou R        *
  4984. *    sortie : d0 pointe sur n2 / n1 de type I ou R (zone creee)    *
  4985. *         Le reste est du signe du dividende         *
  4986. *    interdit : type S                        *
  4987. *    precision : voir routines specialisees            *
  4988. *                                    *
  4989. *===================================================================*
  4990.  
  4991. _mpdiv  cmp.b    #1,([8,sp])
  4992.     bne.s     1$
  4993.     cmp.b    #1,([4,sp])
  4994.     beq     _divii
  4995.     bra     _divri
  4996. 1$      cmp.b    #1,([4,sp])
  4997.     beq     _divir
  4998.     bra     _divrr
  4999.  
  5000. *===================================================================*
  5001. *                                    *
  5002. *            Division (par valeur)            *
  5003. *                                    *
  5004. *    entree : a7($4) pointe sur n2 de type I ou R        *
  5005. *         a7($8) pointe sur n1 de type I ou R        *
  5006. *         a7($12) pointe sur n3 de type I ou R        *
  5007. *    sortie : la zone pointee par a7($12) contient n2 / n1 de    *
  5008. *         type le type de n3                 *
  5009. *    interdit : type S ainsi que les divisions suivantes :    *
  5010. *         R/I=I , I/R=I ,R/R=I                *
  5011. *                                    *
  5012. *===================================================================*
  5013.  
  5014. _mpdivz move.l    a2,-(sp)
  5015.     move.l    _avma,-(sp)
  5016.     move.l    12(sp),a1
  5017.     move.l    16(sp),a0
  5018.     move.l    20(sp),a2    ; a0,a1,a2 pointent sur n1,n2,n3
  5019.     cmp.b    #1,(a2)
  5020.     bne.s     1$
  5021.                 ; ici T3 = I
  5022.     cmp.b    #1,(a1)
  5023.     beq.s     2$
  5024.                 ; ici T3 = I et (T2 = R ou T1 = R)
  5025. 3$      move.l    #divzer1,-(sp)
  5026.     jsr     _err
  5027.                 ; ici T3 = I et T2 = I
  5028. 2$      cmp.b    #1,(a0)
  5029.     bne.s     3$
  5030.                 ; ici T3 = T2 = T1 = I
  5031.     move.l    a0,-(sp)
  5032.     move.l    a1,-(sp)
  5033.     bsr     _divii
  5034.     move.l    a2,4(sp)
  5035.     move.l    d0,(sp)
  5036.     bsr     _affii
  5037.     addq.l    #8,sp
  5038.     bra.s     divzf
  5039.                 ; ici T3 = R
  5040. 1$      move.l    a0,-(sp)
  5041.     cmp.b    #1,(a0)
  5042.     beq.s     4$
  5043.                 ; ici T3 = R et T1 = R
  5044.     move.l    a1,-(sp)
  5045.     cmp.b    #1,(a1)
  5046.     beq.s     5$
  5047.                 ; ici T3 =T2 = T1 = R
  5048.     bsr     _divrr
  5049.     bra.s     6$
  5050.                 ; ici T3 = T1 = R et T2 = I
  5051. 5$      bsr     _divir
  5052.     bra.s     6$
  5053.                 ; ici T3 = R et T1 = I
  5054. 4$      cmp.b    #1,(a1)
  5055.     beq.s     7$
  5056.                 ; ici T3 = T2 = R et T1 = I
  5057.     move.l    a1,-(sp)
  5058.     bsr     _divri
  5059.     bra.s     6$
  5060.                 ; ici T3 = R et T2 = T1 = I
  5061. 7$      move.w    6(a1),d0
  5062.     addq.w    #1,d0
  5063.     bsr     _getr
  5064.     move.l    a0,-(sp)
  5065.     move.l    a1,-(sp)
  5066.     bsr     _affir
  5067.     move.l    4(sp),(sp)
  5068.     move.l    a0,4(sp)
  5069.     bsr     _divrr
  5070. 6$      move.l    a2,4(sp)
  5071.     move.l    d0,(sp)
  5072.     bsr     _affrr
  5073.     addq.l    #8,sp
  5074. divzf     move.l    (sp)+,_avma
  5075.     move.l    (sp)+,a2
  5076.     rts
  5077.  
  5078.                 ; division S/R=R sinon erreur
  5079.  
  5080. _divsrz lea     _divsr,a0
  5081.     bra     mpopz
  5082.  
  5083.                 ; division R/S=R sinon erreur
  5084.  
  5085. _divrsz lea     _divrs,a0
  5086.     bra     mpopz
  5087.  
  5088.                 ; division I/R=R sinon erreur
  5089.  
  5090. _divirz lea     _divir,a0
  5091.     bra     mpopz
  5092.  
  5093.                 ; division R/I=R sinon erreur
  5094.  
  5095. _divriz lea     _divri,a0
  5096.     bra     mpopz
  5097.  
  5098.                 ; division R/R=R sinon erreur
  5099.  
  5100. _divrrz lea     _divrr,a0
  5101.     bra     mpopz
  5102. *===================================================================*
  5103. *                                    *
  5104. *    Division par valeur : entier / entier = entier ou reel    *
  5105. *                                    *
  5106. *    entree : a7($4) contient i2 de type S            *
  5107. *         a7($8) contient i1 de type S            *
  5108. *         a7($12) pointe sur i3 ou r3 de type I ou R     *
  5109. *    sortie : a7($12) pointe sur i2 / i1 de type I ou R        *
  5110. *                                    *
  5111. *===================================================================*
  5112.  
  5113. _divssz cmp.b    #1,([12,sp])
  5114.     bne.s     _divssr
  5115. _divssi  move.l    8(sp),-(sp)
  5116.     move.l    8(sp),-(sp)
  5117.     bsr     _divss
  5118.     move.l    20(sp),4(sp)
  5119.     move.l    d0,(sp)
  5120.     bsr     _affii
  5121.     move.l    (sp),a0
  5122.     addq.l    #8,sp
  5123.     bra     _giv
  5124. _divssr  move.l    _avma,-(sp)
  5125.     move.w    ([16,sp],2),d0
  5126.     bsr     _getr
  5127.     move.l    a0,-(sp)
  5128.     move.l    12(sp),-(sp)
  5129.     bsr     _affsr        ; conversion dividende en R
  5130.     move.l    4(sp),(sp)    ; dividende converti
  5131.     move.l    20(sp),4(sp)    ; diviseur (type S)
  5132.     bsr     _divrs
  5133.     move.l    24(sp),4(sp)
  5134.     move.l    d0,(sp)
  5135.     bsr     _affrr
  5136.     addq.l    #8,sp
  5137.     move.l    (sp)+,_avma
  5138.     rts
  5139.  
  5140. *===================================================================*
  5141. *                                    *
  5142. *    Division par valeur : S / I = entier ou reel        *
  5143. *                                    *
  5144. *    entree : a7($4) contien i2 de type S            *
  5145. *         a7($8) pointe sur i1 de type I             *
  5146. *         a7($12) pointe sur i3 ou r3 de type I ou R     *
  5147. *    sortie : a7($12) pointe sur i2 / i1 de type I ou R        *
  5148. *                                    *
  5149. *===================================================================*
  5150.  
  5151. _divsiz link    a6,#0
  5152.     movem.l    a2-a4,-(sp)
  5153.     move.l    16(a6),a3
  5154.     cmp.b    #1,(a3)
  5155.     bne.s     _divsir
  5156. _divsii  move.l    12(a6),-(sp)
  5157.     move.l    8(a6),-(sp)
  5158.     bsr     _divsi
  5159.     move.l    16(a6),4(sp)
  5160.     move.l    d0,(sp)
  5161.     bsr     _affii
  5162.     move.l    (sp),a0
  5163.     addq.l    #8,sp
  5164.     bsr     _giv
  5165. divsizf movem.l    (sp)+,a2-a4
  5166.     unlk    a6
  5167.     rts
  5168. _divsir  move.l    _avma,a2
  5169.     move.w    2(a3),d0
  5170.     addq.w    #1,d0
  5171.     bsr     _getr
  5172.     move.l    a0,a4
  5173.     move.l    a0,-(sp)
  5174.     move.l    8(a6),-(sp)
  5175.     bsr     _affsr        ; conversion dividende en R
  5176.     addq.l    #2,d0
  5177.     bsr     _getr
  5178.     move.l    a0,4(sp)
  5179.     move.l    12(a6),(sp)
  5180.     bsr     _affir        ; conversion diviseur en R
  5181.     move.l    a4,(sp)
  5182.     bsr     _divrr
  5183.     move.l    a3,4(sp)
  5184.     move.l    d0,(sp)
  5185.     bsr     _affrr
  5186.     addq.l    #8,sp
  5187.     move.l    a2,_avma
  5188.     bra.s     divsizf
  5189.  
  5190. *===================================================================*
  5191. *                                    *
  5192. *    Division par valeur : I / S = entier ou reel        *
  5193. *                                    *
  5194. *    entree : a7($4) pointe sur i2 de type I             *
  5195. *         a7($8) contient i1 de type S            *
  5196. *         a7($12) pointe sur i3 ou r3 de type I ou R     *
  5197. *    sortie : a7($12) pointe sur i2 / i1 de type I ou R        *
  5198. *                                    *
  5199. *===================================================================*
  5200.  
  5201. _divisz cmp.b    #1,([12,sp])
  5202.     bne.s     _divisr
  5203. _divisi  move.l    8(sp),-(sp)
  5204.     move.l    8(sp),-(sp)
  5205.     bsr     _divis
  5206.     move.l    20(sp),4(sp)
  5207.     move.l    d0,(sp)
  5208.     bsr     _affii
  5209.     move.l    (sp),a0
  5210.     addq.l    #8,sp
  5211.     bra     _giv
  5212. _divisr  move.l    _avma,-(sp)
  5213.     move.w    ([16,sp],2),d0
  5214.     bsr     _getr
  5215.     move.l    a0,-(sp)
  5216.     move.l    12(sp),-(sp)
  5217.     bsr     _affir        ; conversion dividende en R
  5218.     move.l    4(sp),(sp)    ; dividende converti
  5219.     move.l    20(sp),4(sp)    ; diviseur (type S)
  5220.     bsr     _divrs
  5221.     move.l    24(sp),4(sp)
  5222.     move.l    d0,(sp)
  5223.     bsr     _affrr
  5224.     addq.l    #8,sp
  5225.     move.l    (sp)+,_avma
  5226.     rts
  5227.  
  5228. *===================================================================*
  5229. *                                    *
  5230. *    Division par valeur : entier / entier = entier ou reel    *
  5231. *                                    *
  5232. *    entree : a7($4) pointe sur i2 de type I             *
  5233. *         a7($8) pointe sur i1 de type I             *
  5234. *         a7($12) pointe sur i3 ou r3 de type I ou R     *
  5235. *    sortie : a7($12) pointe sur i2 / i1 de type I ou R        *
  5236. *                                    *
  5237. *===================================================================*
  5238.  
  5239. _diviiz link    a6,#0
  5240.     movem.l    a2-a4,-(sp)
  5241.     move.l    16(a6),a3
  5242.     cmp.b    #1,(a3)
  5243.     bne.s     _diviir
  5244. _diviii  move.l    12(a6),-(sp)
  5245.     move.l    8(a6),-(sp)
  5246.     bsr     _divii
  5247.     move.l    16(a6),4(sp)
  5248.     move.l    d0,(sp)
  5249.     bsr     _affii
  5250.     move.l    (sp),a0
  5251.     addq.l    #8,sp
  5252.     bsr     _giv
  5253. diviizf movem.l    (sp)+,a2-a4
  5254.     unlk    a6
  5255.     rts
  5256. _diviir  move.l    _avma,a2
  5257.     move.w    2(a3),d0
  5258.     bsr     _getr
  5259.     move.l    a0,a4
  5260.     move.l    a0,-(sp)
  5261.     move.l    8(a6),-(sp)
  5262.     bsr     _affir        ; conversion dividende en R
  5263.     addq.l    #2,d0
  5264.     bsr     _getr
  5265.     move.l    a0,4(sp)
  5266.     move.l    12(a6),(sp)
  5267.     bsr     _affir        ; conversion diviseur en R
  5268.     move.l    a4,(sp)
  5269.     bsr     _divrr
  5270.     move.l    a3,4(sp)
  5271.     move.l    d0,(sp)
  5272.     bsr     _affrr
  5273.     addq.l    #8,sp
  5274.     move.l    a2,_avma
  5275.     bra.s     diviizf
  5276.  
  5277.  
  5278. *===================================================================*
  5279. *                                    *
  5280. *        Division : entier court / entier court = entier     *
  5281. *                                    *
  5282. *    entree : a7($4) contient s2 de type S            *
  5283. *         a7($8) contient s1 de type S            *
  5284. *    sortie : d0 pointe sur s2 div s1 de type I (zone creee)     *
  5285. *         d1.l contient le reste(du signe du dividende)    *
  5286. *                                    *
  5287. *===================================================================*
  5288.  
  5289. _divss  link    a6,#0
  5290.     movem.l    d2-d3,-(sp)
  5291.     moveq    #0,d3
  5292.     move.l    12(a6),d1    ; d1.l recoit s1
  5293.     bne.s     1$
  5294.                 ; ici s1 = 0
  5295.     move.l    #diver1,-(sp)
  5296.     jsr     _err
  5297.                 ; ici s1 <> 0
  5298. 1$      move.l    8(a6),d2    ; d2.l recoit s2
  5299.     bpl    9$
  5300.     moveq    #-1,d3
  5301. 9$    divs.l    d1,d3:d2
  5302.     bne.s     2$
  5303.                 ; ici quotient nul
  5304. 3$      moveq    #2,d0
  5305.     bsr     _geti
  5306.     move.l    #2,4(a0)
  5307.     move.l    d3,d1
  5308.     bra.s     divssf
  5309.                 ; ici quotient non nul
  5310. 2$      moveq    #3,d0
  5311.     bsr     _geti
  5312.     move.l    #$1000003,4(a0)
  5313.     tst.l    d2
  5314.     bpl.s     4$
  5315.     neg.l    d2
  5316.     move.b    #-1,4(a0)
  5317. 4$      move.l    d2,8(a0)
  5318.     move.l    d3,d1
  5319. divssf  move.l    a0,d0
  5320.     movem.l    (sp)+,d2-d3
  5321.     unlk    a6
  5322.     rts
  5323.  
  5324. *===================================================================*
  5325. *                                    *
  5326. *        Division : entier court / entier = entier        *
  5327. *                                    *
  5328. *    entree : a7($4) contient s2 de type S            *
  5329. *         a7($8) contient i1 de type I            *
  5330. *    sortie : d0 pointe sur s2 div i1 de type I (zone creee)     *
  5331. *         d1.l contient le reste (du signe du dividende)     *
  5332. *                                    *
  5333. *===================================================================*
  5334.  
  5335. _divsi  link    a6,#0
  5336.     movem.l    d2-d4,-(sp)
  5337.     move.l    12(a6),a1    ; a1 pointe sur le diviseur i1
  5338.     tst.b    4(a1)
  5339.     bne.s     1$
  5340.                 ; ici i1 = 0
  5341.     move.l    #diver2,-(sp)
  5342.     jsr     _err
  5343.                 ; ici i1 <> 0
  5344. 1$      move.l    8(a6),d2    ; d2.l contient le dividende s2
  5345.     bne.s     3$
  5346.                 ; ici quotient et reste nuls
  5347. 2$      moveq    #2,d0
  5348.     bsr     _geti
  5349.     move.l    #2,4(a0)
  5350.     moveq    #0,d1
  5351.     bra.s     divsif
  5352.                 ; ici i1 et s2 <> 0
  5353. 3$      move.w    6(a1),d1    ; d1.w contient le1
  5354.     cmp.w    #3,d1
  5355.     beq.s     4$
  5356.                 ; ici quotient nul et reste=s2
  5357. 6$      moveq    #2,d0
  5358.     bsr     _geti
  5359.     move.l    #2,4(a0)
  5360.     move.l    d2,d1
  5361.     bra.s     divsif
  5362.                 ; ici L1 = 1
  5363. 4$      move.l    8(a1),d1    ; d1.l contient |i1|
  5364.     move.l    d2,d3        ; d3.l contient s2
  5365.     bpl.s     5$
  5366.     neg.l    d3        ; d3.l contient |s2|
  5367. 5$      moveq    #0,d4
  5368.     divu.l    d1,d4:d3
  5369.     beq.s     6$
  5370.     moveq    #3,d0
  5371.     bsr     _geti
  5372.     move.l    d3,8(a0)    ; ranger mantisse
  5373.     move.l    4(a1),4(a0)
  5374.     tst.l    d2
  5375.     bpl.s     7$
  5376.     move.b    #-1,4(a0)    ; mise a jour du signe
  5377. 7$      move.l    d4,d1
  5378.     tst.b    4(a1)
  5379.     bpl.s     divsif
  5380.     neg.l    d1        ; mise a jour reste
  5381. divsif  move.l    a0,d0
  5382.     movem.l    (sp)+,d2-d4
  5383.     unlk    a6
  5384.     rts
  5385.  
  5386. *===================================================================*
  5387. *                                    *
  5388. *        Division : entier court / reel = reel        *
  5389. *                                    *
  5390. *    entree : a7($4) contient s2 de type S            *
  5391. *         a7($8) pointe sur r1 de type R             *
  5392. *    sortie : d0 pointe sur s2 / r1 de type R (zone creee)    *
  5393. *                                    *
  5394. *===================================================================*
  5395.  
  5396. _divsr  link    a6,#-32
  5397.     movem.l    d2/a2-a4,-(sp)
  5398.     move.l    12(a6),a1    ; a1 pointe sur r1
  5399.     tst.b    4(a1)
  5400.     bne.s     2$
  5401.                 ; ici r1 = 0
  5402.     move.l    #diver3,-(sp)
  5403.     jsr     _err
  5404.                 ; ici r1 <> 0
  5405. 2$      tst.l    8(a6)
  5406.     bne.s     1$
  5407.                 ; ici s2 = 0
  5408.     move.w    #2,d0
  5409.     bsr     _geti
  5410.     move.l    #2,4(a0)
  5411.     move.l    a0,d0
  5412.     bra.s     divsrf
  5413.                 ; ici s2 et r1 <> 0
  5414. 1$      moveq    #0,d0
  5415.     move.w    2(a1),d0
  5416.     bsr     _getr        ; allocation pour resultat
  5417.     move.l    8(a6),d2    ; d2.l recoit s2
  5418.     move.l    a0,a4
  5419.     addq.w    #1,d0
  5420.     bsr     _getr
  5421.     move.l    a0,-(sp)     ; sauvegarde adr. copie
  5422.     move.l    d2,-(sp)
  5423.     bsr     _affsr
  5424.     addq.l    #4,sp
  5425.     move.l    a0,a2        ; a2 pointe sur copie s2
  5426.     move.l    a4,a0        ; a0 pointe sur resultat
  5427.     bsr     dvrr
  5428.     move.l    (sp)+,a0
  5429.     bsr     _giv         ; desallouer copie
  5430.     move.l    a4,d0
  5431. divsrf  movem.l    (sp)+,d2/a2-a4    
  5432.     unlk    a6
  5433.     rts
  5434.  
  5435. *===================================================================*
  5436. *                                    *
  5437. *        Division : entier / entier court = entier        *
  5438. *                                    *
  5439. *    entree : a7($4) pointe sur i2 de type I             *
  5440. *         a7($8) contient s1 de type S            *
  5441. *    sortie : d0 pointe sur i2 / s1 de type I (zone creee)    *
  5442. *        le reste est dans d1.l (du signe du dividende)    *
  5443. *                                    *
  5444. *===================================================================*
  5445.  
  5446. _divis  link    a6,#0
  5447.     movem.l    d2-d6/a2,-(sp)
  5448.     move.l    12(a6),d1    ; d1 recoit s1 diviseur
  5449.     bne.s     1$
  5450.     move.l    #diver4,-(sp)
  5451.     jsr     _err
  5452. 1$      bpl.s     2$
  5453.     neg.l    d1
  5454.                 ; ici d1 contient |s1|
  5455. 2$      move.l    8(a6),a2    ; a2 pointe sur i2 dividende
  5456.     move.w    6(a2),d2    ; d2 recoit le2
  5457.     move.w    4(a2),d5    ; signe de i2
  5458.     bne.s     4$
  5459.                 ; ici i2=0 : q=0 , r=0
  5460. 3$      moveq    #2,d0
  5461.     bsr     _geti
  5462.     move.l    #2,4(a0)
  5463.     moveq    #0,d1        ; reste nul
  5464.     bra.s     divisf
  5465.                 ; ici i2 et s1 <>0
  5466. 4$      move.w    d2,d0        ; d0 recoit le2
  5467.     addq.l    #8,a2
  5468.     move.l    (a2)+,d4
  5469.     moveq    #0,d3
  5470.     divu.l    d1,d3:d4    ; calcul de q0
  5471.     bne.s     5$
  5472.                 ; ici q0 = 0
  5473.     subq.w    #1,d0        ; diminuer long. effective
  5474.     cmp.w    #2,d0
  5475.     bne.s     5$
  5476.                 ; ici q=0 , reste dans d3
  5477.     moveq    #2,d0
  5478.     bsr     _geti
  5479.     move.l    #2,4(a0)
  5480.     bra.s     10$
  5481.                 ; ici q <> 0
  5482. 5$      bsr     _geti
  5483.     move.l    a0,a1
  5484.     move.w    d0,6(a0)    ; met long. effect.
  5485.     move.b    #1,4(a0)
  5486.     move.w    12(a6),d6    ; 'signe de s1'
  5487.     eor.w    d5,d6
  5488.     bpl.s     6$        ; si de meme signe
  5489.     move.b    #-1,4(a0)    ; si de signes contraires
  5490. 6$      addq.l    #8,a1
  5491.     tst.l    d4        ; q0 = 0 ?
  5492.     beq.s     7$
  5493.     move.l    d4,(a1)+     ; non: ranger q0
  5494. 7$      subq.w    #3,d2        ; d2 recoit L1 -1 compteur
  5495.     bra.s     9$
  5496. 8$      move.l    (a2)+,d4     ; boucle de division
  5497.     divu.l    d1,d3:d4
  5498.     move.l    d4,(a1)+
  5499. 9$      dbra    d2,8$
  5500. 10$     move.l    d3,d1        ; le reste est mis dans d1
  5501.     tst.w    d5        ; i1 > 0 ?
  5502.     bpl.s     divisf
  5503.     neg.l    d1        ; non : changer signe de r
  5504. divisf  move.l    a0,d0        ; met addresse resultat
  5505.     movem.l    (sp)+,d2-d6/a2
  5506.     unlk a6
  5507.     rts
  5508.  
  5509. *===================================================================*
  5510. *                                    *
  5511. *        Division : entier / entier = entier         *
  5512. *                                    *
  5513. *    entree : a7($4) pointe sur i2 de type I             *
  5514. *         a7($8) pointe sur i1 de type I             *
  5515. *    sortie : d0 pointe sur i2 / i1 de type I (zone creee)    *
  5516. *         Le reste est du signe du dividende         *
  5517. *                                    *
  5518. *===================================================================*
  5519.  
  5520. _divii  clr.l    -(sp)
  5521.     move.l    12(sp),-(sp)    ; empilage de i1
  5522.     move.l    12(sp),-(sp)    ; empilage de i2
  5523.     bsr     _dvmdii
  5524.     lea     12(sp),sp    ; depilage
  5525.     rts
  5526.  
  5527. *===================================================================*
  5528. *                                    *
  5529. *        Division : entier / reel = reel             *
  5530. *                                    *
  5531. *    entree : a7($4) pointe sur i2 de type I             *
  5532. *         a7($8) pointe sur r1 de type R             *
  5533. *    sortie : d0 pointe sur i2 / r1 de type R (zone creee)    *
  5534. *                                    *
  5535. *===================================================================*
  5536.  
  5537. _divir  link    a6,#-32     ; var. locales pour appel dvrr
  5538.     movem.l    a2-a3,-(sp)
  5539.     move.l    12(a6),a1    ; a1 pointe sur r1
  5540.     tst.b    4(a1)
  5541.     bne.s     1$
  5542.                 ; ici r1 = 0
  5543.     move.l    #diver5,-(sp)
  5544.     jsr     _err
  5545.                 ; ici r1 <> 0
  5546. 1$      move.l    8(a6),a2    ; a2 pointe sur i2
  5547.     tst.b    4(a2)
  5548.     bne.s     2$
  5549.                 ; ici i2 = 0
  5550.     move.w    #2,d0
  5551.     bsr     _geti
  5552.     move.l    #2,4(a0)
  5553.     move.l    a0,d0
  5554.     bra.s     divirf
  5555. 2$      moveq    #0,d0        ; ici i2 et r1 <> 0
  5556.     move.w    2(a1),d0    ; d0.w contient l1
  5557.     bsr     _getr        ; allocation pour resultat
  5558.     move.l    a0,a3
  5559.     addq.w    #1,d0
  5560.     bsr     _getr        ; allocation pour conversion i2 type R
  5561.     move.l    a0,-16(a6)     ; sauvegarde adr. du transforme i2'
  5562.     move.l    a0,-(sp)
  5563.     move.l    a2,-(sp)
  5564.     bsr     _affir
  5565.     addq.l    #8,sp
  5566.     move.l    a0,a2        ; a2 pointe sur i2'
  5567.     move.l    a3,a0        ; a0 pointe sur resultat
  5568.     bsr     dvrr
  5569.     move.l    -16(a6),a0
  5570.     bsr     _giv         ; desallouer i2'
  5571.     move.l    a3,d0
  5572. divirf  movem.l    (sp)+,a2-a3
  5573.     unlk    a6
  5574.     rts
  5575.  
  5576. *===================================================================*
  5577. *                                    *
  5578. *        Division : reel / entier court = reel        *
  5579. *                                    *
  5580. *    entree : a7($4) pointe sur r2 de type R             *
  5581. *         a7($8) pointe sur s1 de type S             *
  5582. *    sortie : d0 pointe sur r2 / s1 de type R (zone creee)    *
  5583. *                                    *
  5584. *===================================================================*
  5585.  
  5586. _divrs  link    a6,#0
  5587.     movem.l    d2-d6/a2,-(sp)
  5588.     move.l    12(a6),d1    ; d1 recoit s1 diviseur
  5589.     bne.s     1$
  5590.                 ; ici s1 = 0
  5591.     move.l    #diver6,-(sp)
  5592.     jsr     _err
  5593.                 ; ici diviseur s1 <> 0
  5594. 1$      move.l    8(a6),a2    ; a2 pointe sur r2 dividende
  5595.     tst.b    4(a2)
  5596.     bne.s     2$
  5597.                 ; ici r2 = 0
  5598.     moveq    #3,d0
  5599.     bsr     _getr
  5600.     tst.l    d1
  5601.     bpl.s     11$
  5602.     neg.l    d1
  5603. 11$     bfffo    d1{0:32},d0
  5604.     add.l    4(a2),d0
  5605.     sub.l    #31,d0
  5606.     bmi     9$
  5607.     move.l    d0,4(a0)
  5608.     clr.l    8(a0)
  5609.     bra     divrsf
  5610.                 ; ici r2 et s1 <> 0
  5611. 2$      move.w    2(a2),d0    ; d0 recoit l2
  5612.     bsr     _getr        ; allocation pour resultat
  5613.     move.b    4(a2),4(a0)    ; signe de r2
  5614.     tst.l    d1
  5615.     bpl.s     3$
  5616.     neg.l    d1        ; d1 recoit |s1| <= 2^31
  5617.                 ; s1 est tjrs <= 1er mot mantisse
  5618.                 ; le 1er quotient partiel est non nul
  5619.     neg.b    4(a0)
  5620. 3$      move.l    a0,a1
  5621.     addq.l    #8,a1
  5622.     addq.l    #8,a2
  5623.     subq.w    #3,d0        ; d0 recoit L2-1 compteur
  5624.     move.l    d0,d2        ; conserve dans d2
  5625.     moveq    #0,d3        ; 1er reste
  5626. 4$      move.l    (a2)+,d4
  5627.     divu.l    d1,d3:d4
  5628.     move.l    d4,(a1)+
  5629.     dbra    d0,4$        ; boucle de division
  5630.  
  5631.     move.l    8(a0),d0    ; resultat normalise ?
  5632.     bpl.s     10$
  5633.     moveq    #0,d1        ; ici normalise ; nb shift = 0
  5634.     bra.s     5$
  5635.                 ; ici il faut normaliser
  5636.  
  5637. 10$     moveq    #0,d4
  5638.     divu.l    d1,d3:d4    ; traite dernier reste: quotient
  5639.                 ; a recuperer par le shift
  5640.     bfffo    d0{0:32},d1    ; nb de shift dans d1
  5641.     lsl.l    d1,d0        ; shift 1er lg mot d0
  5642.     move.l    a0,a1
  5643.     addq.l    #8,a1
  5644.     moveq    #1,d6
  5645.     lsl.l    d1,d6
  5646.     subq.l    #1,d6        ; d6 masque de shift
  5647.     bra.s     7$
  5648. 6$      move.l    4(a1),d3
  5649.     rol.l    d1,d3
  5650.     move.l    d3,d5
  5651.     and.l    d6,d3
  5652.     add.l    d3,d0
  5653.     move.l    d0,(a1)+
  5654.     sub.l    d3,d5
  5655.     move.l    d5,d0
  5656. 7$      dbra    d2,6$
  5657.     rol.l    d1,d4        ; shifter dernier quotient
  5658.     and.l    d6,d4
  5659.     add.l    d4,d0
  5660.     move.l    d0,(a1)
  5661. 5$      move.l    8(a6),a2    ; a2 pointe sur r2 dividende
  5662.     move.l    4(a2),d2
  5663.     and.l    #$ffffff,d2    ; exposant biaise de r2
  5664.     sub.l    d1,d2        ; exposant resultat
  5665.     bpl.s     8$
  5666.                 ; ici underflow
  5667. 9$      move.l    #diver7,-(sp)
  5668.     jsr     _err
  5669. 8$      move.w    d2,6(a0)
  5670.     swap    d2
  5671.     move.b    d2,5(a0)    ; range exposant
  5672. divrsf  move.l    a0,d0
  5673.     movem.l    (sp)+,d2-d6/a2
  5674.     unlk    a6
  5675.     rts
  5676.  
  5677.  
  5678. *===================================================================*
  5679. *                                    *
  5680. *        Division : reel / entier = reel             *
  5681. *                                    *
  5682. *    entree : a7($4) pointe sur r2 de type R             *
  5683. *         a7($8) pointe sur i1 de type I             *
  5684. *    sortie : d0 pointe sur r2 / i1 de type R (zone creee)    *
  5685. *                                    *
  5686. *===================================================================*
  5687.  
  5688. _divri  link    a6,#-32     ; var. locales pour appel dvrr
  5689.     movem.l    d2-d3/a2-a3,-(sp)
  5690.     move.l    12(a6),a1    ; a1 pointe sur le diviseur i1
  5691.     tst.b    4(a1)
  5692.     bne.s     1$
  5693.                 ; ici i1 = 0
  5694.     move.l    #diver8,-(sp)
  5695.     jsr     _err
  5696.                 ; ici i1 <> 0
  5697. 1$      move.l    8(a6),a2    ; a2 pointe sur le dividende r2
  5698.     tst.b    4(a2)
  5699.     bne.s     2$
  5700.                 ; ici r2 = 0
  5701.     moveq    #3,d0
  5702.     bsr     _getr
  5703.     move.w    6(a1),d0
  5704.     lsl.l    #5,d0
  5705.     bfffo    8(a1){0:32},d1
  5706.     add.l    4(a2),d1
  5707.     add.l    #65,d1
  5708.     sub.l    d0,d1
  5709.     bpl.s     3$
  5710.     move.l    #diver12,-(sp)    ; underflow R/I avec R = 0
  5711.     jsr     _err
  5712. 3$      move.l    d1,4(a0)    
  5713.     clr.l    8(a0)
  5714.     move.l    a0,d0
  5715.     bra.s     divrif
  5716.                 ; ici r2 et i1 <> 0
  5717. 2$      moveq    #0,d0
  5718.     move.w    2(a2),d0
  5719.     bsr     _getr        ; allocation pour resultat
  5720.     move.l    _avma,a3    ; eviter le chevauchement
  5721.     subq.l    #8,a3
  5722.     move.l    a3,_avma
  5723.     move.l    #2,(a3)        ; hack pour que giv rende ceci
  5724.     move.l    a0,a3        ; sauvegarde adr. resultat
  5725.     addq.w    #1,d0
  5726.     bsr     _getr        ; allocation pour conversion i1 type R
  5727.     move.l    a0,-16(a6)     ; sauvegarde adr. copie
  5728.     move.l    a0,-(sp)
  5729.     move.l    a1,-(sp)
  5730.     bsr     _affir
  5731.     addq.l    #8,sp
  5732.     move.l    a0,a1        ; a1 pointe sur copie i1
  5733.     move.l    a3,a0        ; a0 pointe sur resultat
  5734.     bsr     dvrr
  5735.     move.l    -16(a6),a0
  5736.     bsr     _giv         ; desallouer copie
  5737.     move.l    a3,d0
  5738. divrif  movem.l    (sp)+,d2-d3/a2-a3
  5739.     unlk    a6
  5740.     rts
  5741.  
  5742. *===================================================================*
  5743. *                                    *
  5744. *        Division : reel / reel = reel            *
  5745. *                                    *
  5746. *    entree : a7($4) pointe sur r2 de type R             *
  5747. *         a7($8) pointe sur r1 de type R             *
  5748. *    sortie : d0 pointe sur r2 / r1 de type R (zone creee)    *
  5749. *    precision : L = inf ( L1 , L2 )                 *
  5750. *                                    *
  5751. *===================================================================*
  5752.  
  5753. _divrr  link    a6,#-32     ; var. locales pour appel dvrr
  5754.     move.l    a2,-(sp)
  5755.     move.l    12(a6),a1    ; a1 pointe sur r1=y diviseur
  5756.     move.l    8(a6),a2    ; a2 pointe sur r2=x dividende
  5757.     tst.b    4(a1)        ; r1 = 0 ?
  5758.     bne.s     1$
  5759.                 ; ici r1 = 0
  5760.     move.l    #diver9,-(sp)
  5761.     jsr     _err
  5762. 1$      tst.b    4(a2)        ; r2 = 0 ?
  5763.     bne.s     3$
  5764.                 ; ici r2=0, r1<>0 : resultat nul
  5765.     moveq    #3,d0
  5766.     bsr     _getr
  5767.     move.l    4(a1),d0    
  5768.     and.l    #$ffffff,d0    ; exposant de r1
  5769.     sub.l    4(a2),d0
  5770.     neg.l    d0
  5771.     add.l    #$800000,d0
  5772.     cmp.l    #$1000000,d0
  5773.     bcs.s     4$
  5774.     move.l    #diver11,-(sp)    ; debordement r/r
  5775.     jsr     _err
  5776. 4$      tst.l    d0
  5777.     bgt.s     5$
  5778.     move.l    #diver10,-(sp)    ; underflow r/r
  5779.     jsr     _err
  5780. 5$      move.l    d0,4(a0)
  5781.     clr.l    8(a0)
  5782.     bra.s     divrrf
  5783. 3$      move.w    2(a1),d0
  5784.     cmp.w    2(a2),d0
  5785.     bls.s     2$
  5786.     move.w    2(a2),d0    ; d0 recoit l=inf(l1,l2)
  5787. 2$      bsr     _getr
  5788.     bsr.s     dvrr        ; effectuer la division !
  5789. divrrf  move.l    a0,d0
  5790.     move.l    (sp),a2
  5791.     unlk    a6
  5792.     rts
  5793.  
  5794. *===================================================================*
  5795. *                                    *
  5796. *    module interne de division r/r (pour R/R,R/I,I/R et S/R)    *
  5797. *    --------------------------------------------------------    *
  5798. *    entree : a1 et a2 pointent sur 2 reels r1 et r2         *
  5799. *    tous 2 non nuls.                        *
  5800. *    a0 pointe sur un type reel de longueur l=inf(l1,l2)     *
  5801. *    ce module a besoin de variables locales reservees et    *
  5802. *    pointees par a6 dans le programme appelant.         *
  5803. *    sortie : le quotient r2/r1 est mis a l'addresse initiale a0 *
  5804. *    (qui n'est pas affectee)                                    *
  5805. *===================================================================*
  5806.  
  5807. dvrr     movem.l    d2-d7/a2-a4,-(sp)
  5808.     move.b    4(a1),d1    ; signe de r1
  5809.     move.b    4(a2),d2    ; signe de r2
  5810.     eor.b    d2,d1                    
  5811.     addq.b    #1,d1
  5812.     move.b    d1,-2(a6)    ; sauvegarde signe resultat
  5813.     move.l    4(a2),d2
  5814.     and.l    #$ffffff,d2
  5815.     move.l    4(a1),d1
  5816.     and.l    #$ffffff,d1
  5817.     sub.l    d1,d2        ; exposant provisoire sans offset
  5818.     add.l    #$800000,d0    ; ajouter offset
  5819.     move.l    d2,-6(a6)    ; sauvegarde
  5820.     move.w    2(a0),d0    ; d0.w recoit longueur resultat ( inf(l1,l2) )
  5821.     move.w    2(a1),d1
  5822.     cmp.w    #3,d1
  5823.     bne.s    5$
  5824.     move.l    8(a1),d1
  5825.     move.l    8(a2),d3
  5826.     clr.l    d2
  5827.     cmp.w    #3,2(a2)
  5828.     beq.s    7$
  5829.     move.l    12(a2),d2
  5830. 7$    cmp.l    d3,d1
  5831.     bls.s    6$
  5832.     divu.l    d1,d3:d2
  5833.     move.l    d2,8(a0)
  5834.     move.l    -6(a6),d0
  5835.     subq.l    #1,d0
  5836.     bra    comd2
  5837. 6$    lsr.l    #1,d3
  5838.     roxr.l    #1,d2
  5839.     divu.l    d1,d3:d2
  5840.     move.l    d2,8(a0)
  5841.     move.l    -6(a6),d0
  5842.     bra    comd2
  5843. 5$    sub.w    d0,d1        ; flag nombre de mots du diviseur
  5844.     move.w    d1,-28(a6)     ; a sauvegarder.
  5845.     subq.w    #2,d0
  5846.     move.w    d0,d7        ; d0 et d7 recoit m=inf(l1,l2)-2
  5847.     move.w    d7,-12(a6)     ; d7 sera compt boucle externe
  5848.     move.l    (a0),-10(a6)    ; sauvegarde 1er lg mot code resultat
  5849.                 ; (on a besoin de toute la place)
  5850.     move.w    2(a2),d6
  5851.     subq.w    #2,d6
  5852.     addq.l    #8,a2        ; a2 pointe sur y1 (1er mot dividende
  5853.                 ; on note y=y1y2...ym le dividende
  5854.     move.l    a0,a4
  5855.     clr.l    (a4)+
  5856. 1$      move.l    (a2)+,(a4)+    ; on recopie m+1 lgmots mantisse de y
  5857.     dbra    d0,1$        ; precede par un zero
  5858.                 ; y(m+1) peut ne pas exister
  5859.                 ; c'est alors n'importe quoi !
  5860.     cmp.w    d7,d6        ; l2>l1 ?
  5861.     bgt.s    4$
  5862.     clr.l    -4(a4)        ; Si l2<=l1, y(m+1) n'existe pas
  5863.                 ; a4 pointe apres y(m+1)
  5864. 4$    move.l    a0,a2        ; a2 pointe sur y0=0 1er mot dividende
  5865.     addq.l    #8,a1        ; a1 pointe sur x1 1er mot diviseur
  5866.     lea     8(a1,d7.w*4),a3 ; a3 pointe apres x(m+2)
  5867.     move.l    a3,-32(a6)
  5868.     move.w    -28(a6),d6     ; (peut etre n'importe quoi mais va etre
  5869.     bne.s     2$        ; corrige)
  5870.     move.l    -8(a3),-20(a6)
  5871.     clr.l    -8(a3)
  5872. 2$      subq.w    #1,d6
  5873.     bgt.s     3$
  5874.     move.l    -4(a3),-24(a6)
  5875.     clr.l    -4(a3)
  5876. 3$      moveq    #0,d6        ; d6 recoit 0 pour les addx
  5877.  
  5878.                 ; Boucles de division R/R
  5879.                 ; d7 compt bcl externe initialise a m
  5880.                 ; pour trouver q0q1...qm
  5881.                 ; d0 compt bcl interne initialise
  5882.                 ; par d7 a chaque tour
  5883. *...................................................................*
  5884. dext     move.l    (a1),d0        ; d0 recoit x1 (1er mot diviseur)
  5885.     cmp.l    (a2),d0        ; compare a yi
  5886.     bne.s     1$
  5887.     move.l    #-1,d1        ; essayer q=2^32-1
  5888.     add.l    4(a2),d0
  5889.     bcs.s     4$
  5890.     move.l    d0,d2
  5891.     bra.s     2$
  5892. 1$      move.l    (a2),d2        ; d2 recoit yi
  5893.     move.l    4(a2),d1    ; d2:d1 recoit yiy(i+1)
  5894.     divu.l    d0,d2:d1    ; d1 recoit q = yiy(i+1) div x1
  5895.                 ; d2 recoit r = yiy(i+1) mod x1
  5896. 2$      move.l    4(a1),d3    ; d3 recoit x2
  5897.     mulu.l    d1,d4:d3    ; d4:d3 recoit q*x2
  5898.     sub.l    8(a2),d3
  5899.     subx.l    d2,d4        ; d4:d3 recoit q*x2-(r,y(i+2))
  5900.     bls.s     4$
  5901.     
  5902. 3$      subq.l    #1,d1        ; ici q est trop grand : q-1
  5903.     sub.l    4(a1),d3
  5904.     subx.l    d0,d4        ; correction du reste partiel
  5905.     bhi.s     3$        ; boucler tant que trop
  5906.                 ; ici q =yiy(i+1)y(i+2) div x1x2 correct
  5907.                 ; on va calculer le reste partiel
  5908. 4$      move.w    d7,d0        ; d0  recoit m-i compteur
  5909.     move.l    a3,a1        ; a3,a1 pointent apres y(m+2-i)
  5910.     move.l    a4,a2        ; a4,a2 pointent apres y(m+1)
  5911.     move.l    -(a1),d2
  5912.     mulu.l    d1,d3:d2    ; initialise retenue d3 par
  5913.     sub.l    d2,d2        ; poids fort de q*y(m+2-i). d2=X=0
  5914. 5$      move.l    -(a1),d5
  5915.     mulu.l    d1,d4:d5    ; boucle interne de multiplication et
  5916.     addx.l    d3,d5        ; soustraction :
  5917.     addx.l    d2,d4        ; yi...y(m+1) recoit yi...y(m+1)-
  5918.     sub.l    d5,-(a2)     ;       q*x1...x(m+1-i)
  5919.     move.l    d4,d3
  5920.     dbra    d0,5$
  5921.     addx.l    d2,d3
  5922.     sub.l    d3,-4(a2)
  5923.     bcc.s     6$
  5924.                 ; ici carry: q encore 1 de trop
  5925.     subq.l    #1,d1
  5926.     move.w    d7,d0
  5927.     move.l    a3,a1
  5928.     move.l    a4,a2
  5929.     subq.l    #4,a1        ; correction sur a1 (car on avait prevu
  5930.                 ; d'initialiser la retenue)
  5931. 7$      addx.l    -(a1),-(a2)
  5932.     dbra    d0,7$        ; boucle de readdition(met reste a jour)
  5933. 6$      move.l    d1,-4(a2)    ; qi correct ! ranger a la place de xi
  5934.     subq.l    #4,a3        ; a3 p. un mot de moins pour bcle suiv.
  5935.                 ; a3 pointe sur x(m-i+1)
  5936. bcdf     dbra    d7,dext     ; fin de boucle externe de division
  5937. *...................................................................*
  5938.     move.l    -32(a6),a3
  5939.     move.w    -28(a6),d5     ; remise eventuelle de xm+1 et xm+2
  5940.     bne.s     7$
  5941.     move.l    -20(a6),-8(a3)
  5942. 7$      subq.w    #1,d5
  5943.     bgt.s     8$
  5944.     move.l    -24(a6),-4(a3)
  5945. 8$      move.w    -12(a6),d5
  5946.     move.w    d5,d4        ; d4 recoit m
  5947. 6$      move.l    -(a2),4(a2)
  5948.     dbra    d5,6$
  5949.     move.l    -10(a6),(a2)+    ; 1er lg mot code;a2 pointe sur q1
  5950.     move.l    -6(a6),d0    ; exposant non biaise
  5951.     move.l    (a2),d1        ; d1 recoit q0=0 ou 1
  5952.     bne.s     1$
  5953.                 ; ici q0=0 : mantisse correcte
  5954.     subq.l    #1,d0        ; retrancher 1 a l'exposant
  5955.     bra.s     comd2
  5956. 1$      addq.l    #4,a2        ; ici q0=1 : shifter de 1 a droite
  5957.     subq.w    #1,d4        ; d4 recoit m-1
  5958.     asr.w    #1,d1        ; met carry flag
  5959. 5$      roxr.w    (a2)+
  5960.     roxr.w    (a2)+
  5961.     dbra    d4,5$        ; boucle de normalisation
  5962. comd2      cmp.l    #$1000000,d0
  5963.     ble.s     3$
  5964.     move.l    #diver10,-(sp)    ; underflow
  5965.     jsr     _err
  5966. 3$      bcs.s     4$
  5967.     move.l    #diver11,-(sp)    ; overflow
  5968.     jsr     _err
  5969. 4$      move.l    d0,4(a0)    ; range exposant
  5970.     move.b    -2(a6),4(a0)    ; range signe
  5971.     movem.l    (sp)+,d2-d7/a2-a5
  5972. dvrrf     rts
  5973.  
  5974.  
  5975.  
  5976.  
  5977. *********************************************************************
  5978. *********************************************************************
  5979. ***                                   ***
  5980. ***             PROGRAMMES D ' INVERSION                  ***
  5981. ***         ( programmes par valeurs : le resultat est      ***
  5982. **            mis dans un REEL existant deja    )      ***
  5983. ***                                   ***
  5984. *********************************************************************
  5985. *********************************************************************
  5986.  
  5987.  
  5988. _mpinvsr move.l    8(sp),-(sp)
  5989.     move.l    8(sp),-(sp)
  5990.     pea     1
  5991.     bsr     _divssr
  5992.     lea     12(sp),sp
  5993.     rts
  5994.  
  5995. _mpinvz cmp.b    #1,([4,sp])
  5996.     bne.s     _mpinvrr
  5997.  
  5998. _mpinvir move.l    8(sp),-(sp)
  5999.     move.l    8(sp),-(sp)
  6000.     pea     1
  6001.     bsr     _divsiz
  6002.     lea     12(sp),sp
  6003.     rts
  6004.  
  6005. _mpinvrr move.l    8(sp),-(sp)
  6006.     move.l    8(sp),-(sp)
  6007.     pea     1
  6008.     bsr     _divsrz
  6009.     lea     12(sp),sp
  6010.     rts
  6011.  
  6012.  
  6013.  
  6014. *********************************************************************
  6015. *********************************************************************
  6016. ***                                   ***
  6017. ***             PROGRAMMES MODULO              ***
  6018. ***                                   ***
  6019. *********************************************************************
  6020. *********************************************************************
  6021.  
  6022.  
  6023.  
  6024.  
  6025.  
  6026.  
  6027. *===================================================================*
  6028. *                                    *
  6029. *            Modulo (par valeur)             *
  6030. *                                    *
  6031. *    entree : a7($4) pointe sur n2 de type I             *
  6032. *         a7($8) pointe sur n1 de type I             *
  6033. *         a7($12) pointe sur n3 de type I            *
  6034. *    sortie : la zone pointee par a7($12) contient le reste de    *
  6035. *         la division de n2 par n1                *
  6036. *         compris entre 0 et abs(n1)-1            *
  6037. *    interdit : type S et R                    *
  6038. *                                    *
  6039. *===================================================================*
  6040.  
  6041. _mpmodz lea     _modii,a0
  6042.     bra     mpopi
  6043.  
  6044.                 ; modulo S mod S = I sinon erreur
  6045.  
  6046. _modssz lea     _modss,a0
  6047.     bra     mpopi
  6048.  
  6049.                 ; modulo S mod I = I sinon erreur
  6050.  
  6051. _modsiz lea     _modsi,a0
  6052.     bra     mpopi
  6053.  
  6054.                 ; modulo I mod S = I sinon erreur
  6055.  
  6056. _modisz lea     _modis,a0
  6057.     bra     mpopi
  6058.  
  6059.                 ; modulo I mod I = I sinon erreur
  6060.  
  6061. _modiiz lea     _modii,a0
  6062.     bra     mpopi
  6063.  
  6064. *===================================================================*
  6065. *                                    *
  6066. *        entier court Modulo entier court = entier        *
  6067. *                                    *
  6068. *    entree : a7($4) contient s2 de type S            *
  6069. *         a7($8) contient s1 de type S            *
  6070. *    sortie : d0 pointe sur s2 mod s1 de type I (zone creee)     *
  6071. *         compris entre 0 et abs(s1)-1            *
  6072. *                                    *
  6073. *===================================================================*
  6074.  
  6075. _modss  link    a6,#0
  6076.     movem.l    d2-d3,-(sp)
  6077.     moveq    #0,d3
  6078.     move.l    12(a6),d1    ; d1.l contient s1
  6079.     bne.s     1$
  6080.                 ; ici s1 = 0
  6081.     move.l    #moder1,-(sp)
  6082.     jsr     _err
  6083.                 ; ici s1 <> 0
  6084. 1$      move.l    8(a6),d2    ; d2.l contient s2
  6085.     bpl    9$
  6086.     moveq    #-1,d3
  6087. 9$    divs.l    d1,d3:d2
  6088.     tst.l    d3
  6089.     bne.s     2$
  6090.                 ; ici reste nul
  6091. 3$      moveq    #2,d0
  6092.     bsr     _geti
  6093.     move.l    #2,4(a0)
  6094.     bra.s     7$
  6095.                 ; ici reste non nul
  6096. 2$      bmi.s     5$
  6097.                 ; ici reste > 0
  6098.     moveq    #3,d0
  6099.     bsr     _geti
  6100.     move.l    #$1000003,4(a0)
  6101.     move.l    d3,8(a0)
  6102.     bra.s 7$
  6103.                 ; ici reste < 0
  6104. 5$      move.l    12(a6),-(sp)
  6105.     move.l    d3,-(sp)
  6106.     tst.l    d1
  6107.     bpl.s     6$
  6108.                 ; ici s1 < 0
  6109.     bsr     _subss
  6110.     addq.l    #8,sp
  6111.     bra.s     modssf
  6112.                 ; ici s1 > 0
  6113. 6$      bsr     _addss
  6114.     addq.l    #8,sp
  6115.     bra.s     modssf
  6116. 7$      move.l    a0,d0
  6117. modssf  movem.l    (sp)+,d2-d3
  6118.     unlk    a6
  6119.     rts
  6120.  
  6121. *===================================================================*
  6122. *                                    *
  6123. *        entier court Modulo entier = entier         *
  6124. *                                    *
  6125. *    entree : a7($4) contient s2 de type S            *
  6126. *         a7($8) ppinte sur i1 de type I             *
  6127. *    sortie : d0 pointe sur s2 mod i1 de type I (zone creee)     *
  6128. *         compris entre 0 et abs(i1)-1            *
  6129. *                                    *
  6130. *===================================================================*
  6131.  
  6132. _modsi  link    a6,#0
  6133.     movem.l    d2-d3,-(sp)
  6134.     move.l    12(a6),-(sp)
  6135.     move.l    8(a6),-(sp)
  6136.     bsr     _divsi
  6137.     addq.l    #8,sp
  6138.     move.l    d0,a0
  6139.     bsr     _giv         ; desallouer memoire provisoire
  6140.     tst.l    d1        ; tester le reste
  6141.     bne.s     1$
  6142.                 ; ici reste nul
  6143.     moveq    #2,d0
  6144.     bsr     _geti
  6145.     move.l    #2,4(a0)
  6146.     bra.s     2$
  6147.                 ; ici reste non nul
  6148. 1$      bmi.s     3$
  6149.                 ; ici reste > 0
  6150.     move.l    d1,d3        ; d3.l recoit le reste
  6151.     moveq    #3,d0
  6152.     bsr     _geti
  6153.     move.l    #$1000003,4(a0)
  6154.     move.l    d3,8(a0)
  6155.     bra.s     2$
  6156.                 ; ici reste < 0
  6157. 3$      move.l    12(a6),-(sp)
  6158.     move.l    d1,-(sp)
  6159.     move.l    12(a6),a1    ; a1 pointe sur i1
  6160.     tst.b    4(a1)
  6161.     bpl.s     5$
  6162.                 ; ici i1 < 0
  6163.     bsr     _subsi
  6164.     bra.s     6$
  6165.                 ; ici i1 > 0
  6166. 5$      bsr     _addsi
  6167. 6$      addq.l    #8,sp
  6168.     bra.s     modsif
  6169. 2$      move.l    a0,d0
  6170. modsif  movem.l    (sp)+,d2-d3
  6171.     unlk    a6
  6172.     rts
  6173.  
  6174. *===================================================================*
  6175. *                                    *
  6176. *        entier Modulo entier court = entier         *
  6177. *                                    *
  6178. *    entree : a7($4) pointe sur i2 de type I             *
  6179. *         a7($8) contient s1 de type S            *
  6180. *    sortie : d0 pointe sur i2 mod s1 de type I (zone creee)     *
  6181. *         compris entre 0 et abs(s1)-1            *
  6182. *                                    *
  6183. *===================================================================*
  6184.  
  6185. _modis  link    a6,#0
  6186.     movem.l    d2-d3,-(sp)
  6187.     move.l    12(a6),-(sp)
  6188.     move.l    8(a6),-(sp)
  6189.     bsr     _divis
  6190.     addq.l    #8,sp
  6191.     move.l    d0,a0
  6192.     bsr     _giv
  6193.     tst.l    d1
  6194.     bne.s     1$
  6195.                 ; ici reste nul
  6196.     moveq    #2,d0
  6197.     bsr     _geti
  6198.     move.l    #2,4(a0)
  6199.     bra.s     2$
  6200.                 ; ici reste non nul
  6201. 1$      bmi.s     3$
  6202.                 ; ici reste > 0
  6203.     move.l    d1,d3
  6204.     moveq    #3,d0
  6205.     bsr     _geti
  6206.     move.l    #$1000003,4(a0)
  6207.     move.l    d3,8(a0)
  6208.     bra.s     2$
  6209.                 ; ici reste < 0
  6210. 3$      move.l    12(a6),-(sp)
  6211.     move.l    d1,-(sp)
  6212.     move.l    12(a6),d1    ; d1.l contient s1
  6213.     bpl.s     5$
  6214.     bsr     _subss
  6215.     bra.s     6$
  6216. 5$      bsr     _addss
  6217. 6$      addq.l    #8,sp
  6218.     bra.s     modisf
  6219. 2$      move.l    a0,d0
  6220. modisf  movem.l    (sp)+,d2-d3
  6221.     unlk    a6
  6222.     rts
  6223.  
  6224. *===================================================================*
  6225. *                                    *
  6226. *        entier Modulo entier = entier            *
  6227. *                                    *
  6228. *    entree : a7($4) pointe sur i2 de type I             *
  6229. *         a7($8) pointe sur i1 de type I             *
  6230. *    sortie : d0 pointe sur i2 mod i1 de type I            *
  6231. *         compris entre 0 et abs(i1)-1(zone creee)        *
  6232. *                                    *
  6233. *===================================================================*
  6234.  
  6235. _modii  link    a6,#-4
  6236.     move.l    #-1,-(sp)
  6237.     move.l    12(a6),-(sp)    ; empilage adresse i1
  6238.     move.l    8(a6),-(sp)     ; empilage adresse i2
  6239.     move.l    _avma,-4(a6)    ; sauvegarde adr. tete pile PARI
  6240.     bsr     _dvmdii
  6241.     move.l    d0,a1        ; a1 pointe sur resultat
  6242.     tst.b    4(a1)
  6243.     bpl.s     modiif
  6244.                 ; ici reste negatif
  6245.     move.l    a1,(sp)        ; empilage adr. du reste
  6246.     tst.b    ([12,a6],4)     ; test signe du modulo
  6247.     bpl.s     1$
  6248.     bsr     _subii
  6249.     bra.s     2$
  6250. 1$      bsr     _addii
  6251. 2$      move.l    (sp)+,a1
  6252.     move.l    _avma,a0
  6253.     move.w    2(a0),d0
  6254.     subq.w    #1,d0
  6255.     move.l    -4(a6),a0    ; a0 pointe sur pile initiale
  6256. 3$      move.l    -(a1),-(a0)
  6257.     dbra    d0,3$        ; ecraser resultat intermediaire
  6258.     move.l    a0,_avma
  6259.     move.l    a0,d0        ; nouvelle adresse resultat
  6260. modiif  unlk    a6
  6261.     rts
  6262.  
  6263.  
  6264.  
  6265.  
  6266.  
  6267. *********************************************************************
  6268. *********************************************************************
  6269. ***                                   ***
  6270. ***     PROGRAMMES DE RESTE DES DIVISIONS ENTIERES          ***
  6271. ***                                   ***
  6272. *********************************************************************
  6273. *********************************************************************
  6274.  
  6275.  
  6276.  
  6277.  
  6278.  
  6279. *===================================================================*
  6280. *                                    *
  6281. *            Reste (par valeur)                *
  6282. *                                    *
  6283. *    entree : a7($4) pointe sur n2 de type I             *
  6284. *         a7($8) pointe sur n1 de type I             *
  6285. *         a7($12) pointe sur n3 de type I            *
  6286. *    sortie : la zone pointee par a7($12) contient le reste de    *
  6287. *         la division de n2 par n1 (du signe du dividende)    *
  6288. *    interdit : type S et R                    *
  6289. *                                    *
  6290. *===================================================================*
  6291.  
  6292. _mpresz lea     _resii,a0
  6293.     bra     mpopi
  6294.  
  6295.                 ; reste de S/S = I sinon erreur
  6296.  
  6297. _resssz lea     _resss,a0
  6298.     bra     mpopi
  6299.  
  6300.                 ; reste de S/I = I sinon erreur
  6301.  
  6302. _ressiz lea     _ressi,a0
  6303.     bra     mpopi
  6304.  
  6305.                 ; reste de I/S = I sinon erreur
  6306.  
  6307. _resisz lea     _resis,a0
  6308.     bra     mpopi
  6309.  
  6310.                 ; reste de I/I = I sinon erreur
  6311.  
  6312. _resiiz lea     _resii,a0
  6313.     bra     mpopi
  6314.  
  6315. *===================================================================*
  6316. *                                    *
  6317. *        Reste : entier court / entier court = entier    *
  6318. *                                    *
  6319. *    entree : a7($4) contient s2 de type S            *
  6320. *         a7($8) contient s1 de type S            *
  6321. *    sortie : d0 pointe sur le reste de la division s2 / s1    *
  6322. *         de type I (zone creee)                 *
  6323. *         Le reste est du signe du dividende         *
  6324. *                                    *
  6325. *===================================================================*
  6326.  
  6327. _resss  link    a6,#0
  6328.     movem.l    d2-d3,-(sp)
  6329.     moveq    #0,d3
  6330.     move.l    12(a6),d1    ; d1.l contient le diviseur s1
  6331.     bne.s     1$
  6332.                 ; ici s1 = 0
  6333.     move.l    #reser1,-(sp)
  6334.     jsr     _err
  6335.                 ; ici s1 <> 0
  6336. 1$      move.l    8(a6),d2    ; d2.l contient s2
  6337.     bpl    9$
  6338.     moveq    #-1,d3
  6339. 9$    divs.l    d1,d3:d2
  6340.     tst.l    d3
  6341.     bne.s     2$
  6342.                 ; ici reste nul
  6343.     moveq    #2,d0
  6344.     bsr     _geti
  6345.     move.l    #2,4(a0)
  6346.     bra.s     resssf
  6347.                 ; ici reste non nul
  6348. 2$      moveq    #3,d0
  6349.     bsr     _geti
  6350.     move.l    #$1000003,4(a0)
  6351.     tst.l    d3
  6352.     bpl.s     3$
  6353.     neg.l    d3
  6354.     move.b    #-1,4(a0)
  6355. 3$      move.l    d3,8(a0)
  6356. resssf  move.l    a0,d0
  6357.     movem.l    (sp)+,d2-d3
  6358.     unlk    a6
  6359.     rts
  6360.  
  6361. *===================================================================*
  6362. *                                    *
  6363. *        Reste : entier court / entier = entier        *
  6364. *                                    *
  6365. *    entree : a7($4) contient s2 de type S            *
  6366. *         a7($8) pointe sur i1 de type I             *
  6367. *    sortie : d0 pointe sur le reste de la division s2 / i1    *
  6368. *         de type I (zone creee)                 *
  6369. *         Le reste est du signe du dividende         *
  6370. *                                    *
  6371. *===================================================================*
  6372.  
  6373. _ressi  move.l    8(sp),-(sp)     ; empilage adr. i1
  6374.     move.l    8(sp),-(sp)     ; empilage s2
  6375.     bsr     _divsi
  6376.     move.l    d0,a0        ; a0 pointe sur resultat prov.
  6377.     bsr     _giv
  6378.     tst.l    d1        ; d1.l contient le reste
  6379.     bne.s     1$
  6380.                 ; ici reste nul
  6381.     moveq    #2,d0
  6382.     bsr     _geti
  6383.     move.l    #2,4(a0)
  6384.     bra.s     ressif
  6385.                 ; ici reste non nul
  6386. 1$      moveq    #3,d0
  6387.     bsr     _geti
  6388.     move.l    #$1000003,4(a0)
  6389.     tst.l    d1
  6390.     bpl.s     2$
  6391.     neg.l    d1
  6392.     move.b    #-1,4(a0)
  6393. 2$      move.l    d1,8(a0)
  6394. ressif  move.l    a0,d0
  6395.     addq.l    #8,sp
  6396.     rts
  6397.  
  6398. *===================================================================*
  6399. *                                    *
  6400. *        Reste : entier / entier court = entier        *
  6401. *                                    *
  6402. *    entree : a7($4) pointe sur i2 de type I             *
  6403. *         a7($8) contient s1 de type S            *
  6404. *    sortie : d0 pointe sur le reste de la division i2 / s1    *
  6405. *         (zone creee)                    *
  6406. *         Le reste est du signe du dividende         *
  6407. *                                    *
  6408. *===================================================================*
  6409.  
  6410. _resis  move.l    8(sp),-(sp)     ; empilage s1
  6411.     move.l    8(sp),-(sp)     ; empilage adr.i2
  6412.     bsr     _divis
  6413.     move.l    d0,a0
  6414.     bsr     _giv         ; desallouer memoire provisoire
  6415.     tst.l    d1        ; le reste est dans d1.l
  6416.     bne.s     1$
  6417.                 ; ici reste nul
  6418.     moveq    #2,d0
  6419.     bsr     _geti
  6420.     move.l    #2,4(a0)
  6421.     bra.s     resisf
  6422.                 ; ici reste non nul
  6423. 1$      moveq    #3,d0
  6424.     bsr     _geti
  6425.     move.l    #$1000003,4(a0)
  6426.     tst.l    d1
  6427.     bpl.s     2$
  6428.     neg.l    d1
  6429.     move.b    #-1,4(a0)
  6430. 2$      move.l    d1,8(a0)
  6431. resisf  move.l    a0,d0
  6432.     addq.l    #8,sp
  6433.     rts
  6434.  
  6435. *===================================================================*
  6436. *                                    *
  6437. *        Reste : entier / entier = entier            *
  6438. *                                    *
  6439. *    entree : a7($4) pointe sur i2 de type I             *
  6440. *         a7($8) pointe sur i1 de type I             *
  6441. *    sortie : d0 pointe sur le reste de la division i2 / i1    *
  6442. *         de type I (zone creee)                 *
  6443. *         ( du signe du dividende)                *
  6444. *                                    *
  6445. *===================================================================*
  6446.  
  6447. _resii  move.l    #-1,-(sp)
  6448.     move.l    12(sp),-(sp)
  6449.     move.l    12(sp),-(sp)
  6450.     bsr     _dvmdii
  6451.     lea     12(sp),sp
  6452.     rts
  6453.  
  6454. *===================================================================*
  6455. *                                    *
  6456. *            Operations par valeur            *
  6457. *                                    *
  6458. *    entree : a7($4) contient n2 de type S ou pointe sur n2    *
  6459. *         de type I ou R                     *
  6460. *         a7($8) contient n1 de type S ou pointe sur n1    *
  6461. *         de type I ou R                     *
  6462. *         a7($12) pointe sur n3 de type I ou R        *
  6463. *    sortie : la zone pointee par a7($12) contient n2 op n1    *
  6464. *    remarque : les erreurs de type sont detectees dans l'       *
  6465. *           affectation du resultat                *
  6466. *                                    *
  6467. *===================================================================*
  6468.  
  6469.                 ; operation a trois operandes
  6470.                 ; les trois operandes sont de type I
  6471.  
  6472. mpariz  move.b    ([12,sp]),d0
  6473.     add.b    ([8,sp]),d0
  6474.     add.b    ([4,sp]),d0
  6475.     cmp.b    #3,d0
  6476.     beq.s     mpopz
  6477.     move.l    #arier1,-(sp)
  6478.     jsr     _err    
  6479.  
  6480.                 ; le troisieme operande est de type I
  6481.  
  6482. mpopi     cmp.b    #1,([12,sp])
  6483.     beq.s     mpopz
  6484.     move.l    #arier2,-(sp)
  6485.     jsr     _err
  6486.                 ; operation quelconque
  6487.  
  6488. mpopz     move.l    8(sp),-(sp)     ; 2eme operande
  6489.     move.l    8(sp),-(sp)     ; 1er operande
  6490.     jsr     (a0)
  6491.     move.l    20(sp),4(sp)    ; 3eme operande
  6492.     move.l    d0,(sp)        ; resultat operation
  6493.     jsr     _mpaff
  6494.     addq.l    #8,sp
  6495.     move.l    d0,a0
  6496.     bra     _giv
  6497.  
  6498.                 ; operation a quatre operandes
  6499.                 ; avec deux resultats de type I
  6500.  
  6501. mpopii  move.b    ([16,sp]),d0
  6502.     add.b    ([12,sp]),d0
  6503.     cmp.b    #2,d0
  6504.     beq.s     mpopz2
  6505.     move.l    #arier2,-(sp)
  6506.     jsr     _err
  6507.  
  6508.                 ; operation a quatre operande
  6509.  
  6510. mpopz2  link    a6,#-8
  6511.     move.l    _avma,-8(a6)
  6512.     pea     -4(a6)
  6513.     move.l    12(a6),-(sp)    ; 2eme operande
  6514.     move.l    8(a6),-(sp)     ; 1er operande
  6515.     jsr     (a0)
  6516.     addq.l    #4,sp
  6517.     move.l    -4(a6),(sp)
  6518.     move.l    20(a6),4(sp)
  6519.     bsr     _mpaff        ; rangement 2 eme resultat
  6520.     move.l    d0,(sp)
  6521.     move.l    16(a6),4(sp)
  6522.     bsr     _mpaff        ; rangement 1 er resultat
  6523.     addq.l    #8,sp
  6524.     move.l    -8(a6),_avma
  6525.     unlk    a6
  6526.     rts
  6527.  
  6528.  
  6529.  
  6530.  
  6531.  
  6532. *********************************************************************
  6533. *********************************************************************
  6534. ***                                   ***
  6535. ***     PROGRAMMES PAR VALEUR UTILISES POUR LA LECTURE-ECRITURE   ***
  6536. ***                                   ***
  6537. *********************************************************************
  6538. *********************************************************************
  6539.  
  6540.  
  6541.  
  6542.  
  6543.  
  6544. *===================================================================*
  6545. *                                    *
  6546. *    Multiplication par valeur : entier court * entier = entier    *
  6547. *                                    *
  6548. *    entree : a7($4) contient s2 de type S            *
  6549. *         a7($8) pointe sur i1 de type I             *
  6550. *         a7($12) pointe sur i3 de type I            *
  6551. *    sortie : i3 pointe sur s2 * i1                *
  6552. *                                    *
  6553. *===================================================================*
  6554.  
  6555. _mulsii move.l    8(sp),-(sp)
  6556.     move.l    8(sp),-(sp)
  6557.     bsr     _mulsi
  6558.     move.l    20(sp),4(sp)
  6559.     move.l    d0,(sp)
  6560.     bsr     _affii
  6561.     move.l    (sp),a0
  6562.     addq.l    #8,sp
  6563.     bra     _giv
  6564.  
  6565. *===================================================================*
  6566. *                                    *
  6567. *    Addition par valeur : entier court + entier = entier    *
  6568. *                                    *
  6569. *    entree : a7($4) contient s2 de type S            *
  6570. *         a7($8) pointe sur i1 de type I             *
  6571. *         a7($12) pointe sur i3 de type I            *
  6572. *    sortie : i3 pointe sur s2 + i1                *
  6573. *                                    *
  6574. *===================================================================*
  6575.  
  6576. _addsii move.l    8(sp),-(sp)
  6577.     move.l    8(sp),-(sp)
  6578.     bsr     _addsi
  6579.     move.l    20(sp),4(sp)
  6580.     move.l    d0,(sp)
  6581.     bsr     _affii
  6582.     move.l    (sp),a0
  6583.     addq.l    #8,sp
  6584.     bra     _giv
  6585.  
  6586. *===================================================================*
  6587. *                                    *
  6588. *            division I / S = I                *
  6589. *                                    *
  6590. *    entree: a7($4) pointe sur i2, a7($8) contient s1        *
  6591. *        a7($12) pointe sur un type I            *
  6592. *    sortie: a7($12) pointe sur i2 div s1            *
  6593. *        d1 contient i2 mod s1                *
  6594. *                                    *
  6595. *===================================================================*
  6596.  
  6597. _divisii move.l    8(sp),-(sp)
  6598.     move.l    8(sp),-(sp)
  6599.     bsr     _divis
  6600.     move.l    20(sp),4(sp)
  6601.     move.l    d0,(sp)
  6602.     bsr     _affii
  6603.     move.l    (sp),a0
  6604.     addq.l    #8,sp
  6605.     bra     _giv
  6606.  
  6607.     
  6608. *===================================================================*
  6609. *                                    *
  6610. *    Conversion    type I --> base 10^9                *
  6611. *                                    *
  6612. *    entree : a7($4) pointe sur un type I            *
  6613. *    sortie : le resultat recoit I converti en base 10^9,    *
  6614. *         sans signe, avec un -1 artificiel au debut     *
  6615. *         d0 pointe apres la zone du resultat        *
  6616. *                                    *
  6617. *===================================================================*
  6618.  
  6619. _convi  link    a6,#0
  6620.     movem.l    d2/a2-a3,-(sp)
  6621.     move.l    _avma,d2
  6622.     move.l    8(a6),-(sp)
  6623.     bsr     _absi
  6624.     move.l    d0,a3
  6625.     move.w    6(a3),d0
  6626.     subq.w    #2,d0
  6627.     mulu    #15,d0
  6628.     divu    #14,d0
  6629.     addq.w    #3,d0
  6630.     bsr     _geti
  6631.     move.l    a0,a2
  6632.     addq.l    #4,a2
  6633.     move.l    #-1,(a2)+
  6634.     move.l    a3,-(sp)
  6635.     move.l    #1000000000,-(sp)
  6636.     move.l    a3,-(sp)
  6637.     tst.b    4(a3)
  6638.     bne.s     1$
  6639.     clr.l    (a2)+        ; ici entier nul
  6640.     bra.s     2$        
  6641. 1$      bsr.s     _divisii
  6642.     move.l    d1,(a2)+
  6643.     tst.b    4(a3)
  6644.     bne.s     1$
  6645. 2$      lea     16(sp),sp
  6646.     move.l    a2,d0
  6647.     move.l    d2,_avma
  6648.     movem.l    (sp)+,d2/a2-a3
  6649.     unlk    a6
  6650. convif  rts
  6651.  
  6652. *===================================================================*
  6653. *                                    *
  6654. *    Conversion partie fractionnaire --> base 10^9        *
  6655. *                                    *
  6656. *    entree : a7($4) pointe sur un type R de module < 1        *
  6657. *    sortie : le resultat en base 10^9 precede par nb de dec.    *
  6658. *         d0 pointe sur le resultat                *
  6659. *                                    *
  6660. *===================================================================*
  6661.  
  6662. _confrac link    a6,#-12
  6663.     movem.l    d2-d7/a2-a3,-(sp)
  6664.     move.l    _avma,-8(a6)
  6665.     move.l    8(a6),a1
  6666.     clr.l    d0
  6667.     move.w    2(a1),d0
  6668.     move.l    4(a1),d1
  6669.     and.l    #$ffffff,d1
  6670.     sub.l    #$800000,d1
  6671.     not.l    d1
  6672.     move.l    d1,d7        ; d1 et d7 recoivent -e-1
  6673.     subq.l    #2,d0        ; d0 recoit L
  6674.     lsl.l    #5,d0
  6675.     add.l    d1,d0
  6676.     move.l    d0,d2        ; d0 et d2 recoivent 32*L-e-1
  6677.     add.l    #95,d0        ; 95=3*32-1
  6678.     lsr.l    #5,d0
  6679.     bsr     _geti        ; alloc. pour mantisse denormalisee
  6680.     move.l    d0,-4(a6)
  6681.     lsr.l    #5,d7        ; d7 recoit -e-1 div 32
  6682.     move.l    a0,a2
  6683.     bra.s     1$
  6684. 2$      clr.l    (a0)+
  6685. 1$      dbra    d7,2$
  6686.     move.w    2(a1),d3
  6687.     subq.l    #3,d3        ; d3 recoit L-1 compteur
  6688.     addq.l    #8,a1
  6689.     and.l    #31,d1        ; d1 recoit -e-1 mod 32 = nb de shifts
  6690.     bne.s     3$
  6691.                 ; ici pas de shift
  6692. 4$      move.l    (a1)+,(a0)+
  6693.     dbra    d3,4$
  6694.     bra.s     5$
  6695. 3$      moveq    #-1,d6
  6696.     lsr.l    d1,d6        ; masque de shift
  6697.     moveq    #0,d4
  6698. 6$      move.l    (a1)+,d0
  6699.     ror.l    d1,d0
  6700.     move.l    d0,d5
  6701.     and.l    d6,d5
  6702.     sub.l    d5,d0
  6703.     add.l    d4,d5
  6704.     move.l    d5,(a0)+
  6705.     move.l    d0,d4
  6706.     dbra    d3,6$
  6707.     move.l    d4,(a0)+
  6708. 5$      clr.l    (a0)
  6709.     mulu.l    #8651,d3:d2
  6710.     divu.l    #28738,d3:d2    ; on mult par Log(2)/Log(10)=0.30103
  6711.     move.l    d2,d0
  6712.     addq.l    #1,d0
  6713.     move.l    d0,d7        ; d0,d7 <-- ndecfrac=nb de decimales
  6714.     add.l    #17,d0        ; 17=2*9-1
  6715.     divu    #9,d0
  6716.     bsr     _geti        ; alloc memoire pour resultats
  6717.     move.l    a0,-12(a6)     ; adresse resultats
  6718.     move.l    d7,(a0)+     ; ndecfrac est passe au prog C
  6719.     subq.w    #2,d0        ; d0 recoit compteur nb de mult.
  6720.     move.l    -4(a6),d1    ; longueur mantisse denormalisee
  6721.     lea     0(a2,d1.w*4),a2
  6722.     subq.l    #1,d1
  6723.     move.l    a2,a3        ; a2 et a3 pointent apres mant.denorm.
  6724.     move.l    d1,d3
  6725.     move.l    #1000000000,d6
  6726.     clr.l    d7
  6727. boext     clr.l    d2
  6728. 1$      move.l    -(a2),d5
  6729.     mulu.l    d6,d4:d5
  6730.     add.l    d2,d5
  6731.     addx.l    d7,d4
  6732.     move.l    d5,(a2)
  6733.     move.l    d4,d2
  6734.     dbra    d1,1$    
  6735.     move.l    d2,(a0)+
  6736.     move.l    a3,a2        ; adr apres fin mantisse denorm.
  6737.     move.l    d3,d1
  6738.     dbra    d0,boext
  6739.     move.l    -12(a6),d0     ; d0 pointe sur le resultat
  6740.     movem.l    (sp)+,d2-d7/a2-a3
  6741.     move.l    -8(a6),_avma
  6742.     unlk    a6
  6743.     rts
  6744.  
  6745.  
  6746.  
  6747.  
  6748.  
  6749. *===================================================================*
  6750. *                                    *
  6751. *        Reservations memoire pour systeme PARI        *
  6752. *                                    *
  6753. *===================================================================*
  6754.  
  6755.  
  6756.     even
  6757. *    .lcomm    _bot,4        ; pile PARI
  6758. *    .lcomm    _top,4        ; tete pile PARI
  6759. *    .lcomm    __avma,4     ; memoire contenant adr. sommet pile PARI
  6760.     END
  6761.